mirror-img/t/mirror-img.lisp

;;;; mirror-img/tests: Tests for the mirror-img package.

;; Copyright © 2024 Jaidyn Ann <jadedctrl@posteo.at>
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.

(defpackage :mirror-img/tests
  (:use :cl :lisp-unit2)
  (:export :run))

(in-package :mirror-img/tests)

(defparameter *mirror-img-result* nil)

(defun relative-pathname (path)
  (asdf:system-relative-pathname :mirror-img/tests path))

(defun run ()
  (let* ((doc-root (relative-pathname "t/testing-website/"))
         (acceptor (make-instance 'hunchentoot:easy-acceptor
                                  :port 4242
                                  :document-root doc-root))
         (server (hunchentoot:start acceptor)))
    (lisp-unit2:with-summary ()
      (run-tests :package :mirror-img/tests)
      (hunchentoot:stop server))))

(define-test mirror-img (:tags '(mirror-img))
  (assert-eq
   (stringp
    (setq *mirror-img-result*
          (mirror-img:mirror-img (relative-pathname "t/testing-website/index.html")
                                 "tmp")))
   'T))

(define-test mirror-img.files-mirrored (:tags '(mirror-img))
  (assert-equal
   (sort (mapcar #'pathname-name
                 (uiop:directory-files (relative-pathname "t/tmp/localhost/")))
         #'string-lessp)
   '("café" "fireplace" "merry christmas!!! ^_^" "more_calming" "style" "welcoming you")))

(define-test mirror-img.correct-urls (:tags '(mirror-img))
  (assert-equal
   (sort (mirror-img::linked-urls
          (lquery:$ (lquery:initialize *mirror-img-result*)))
         #'string-lessp)
   '("tmp/localhost/café.jpg"
     "tmp/localhost/classy_fireplace.jpg"
     "tmp/localhost/fireplace.jpg"
     "tmp/localhost/merry christmas!!! ^_^.jpg"
     "tmp/localhost/more_calming.jpg"
     "tmp/localhost/style.css"
     "tmp/localhost/welcoming you.jpg")))

(define-test mirrored-pathname (:tags '(base))
  (assert-equal
   (mirror-img::mirrored-pathname "https://invalid.tld/dir/bird apple.txt"
                                  :base-dir #p"base/")
   #p"base/invalid.tld/bird apple.txt"))

(define-test linked-urls (:tags '(dom))
  (assert-equal
   (sort (mirror-img::linked-urls
          (lquery:$ (lquery:initialize
                     (relative-pathname "t/testing-website/index.html"))))
         #'string-lessp)
   '("http://localhost:4242/res/img/b/fireplace.jpg"
     "http://localhost:4242/res/img/b/I’m trying hard to randomly name these directories/more_calming.jpg"
     "http://localhost:4242/res/img/b/I’m trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas%3F!/classy_fireplace.jpg"
     "http://localhost:4242/res/img/level-2/café.jpg"
     "http://localhost:4242/res/img/merry christmas!!! ^_^.jpg"
     "http://localhost:4242/res/style.css"
     "http://localhost:4242/res/welcoming you.jpg")))

(define-test url-encode-uri.space (:tags '(util))
  (assert-equal
   (mirror-img::url-encode-uri "https://invalid.tld/dad alive.jpg")
   "https://invalid.tld/dad%20alive.jpg"))

(define-test url-encode-path.space+exclamation (:tags '(util))
  (assert-equal
   (mirror-img::url-encode-path "/images!/dad alive.jpg")
   "/images%21/dad%20alive.jpg"))