;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-import-latest-git)
  #:use-module (git)
  #:use-module (guix git)
  #:use-module (guix tests)
  #:use-module (guix packages)
  #:use-module (guix import latest-git)
  #:use-module (guix upstream)
  #:use-module (guix git-download)
  #:use-module (guix hg-download)
  #:use-module (guix tests git)
  #:use-module (guix build utils)
  #:use-module (srfi srfi-64))

(test-begin "git")

(define latest-git-upstream
  (upstream-updater-latest %latest-git-updater))

(define with-latest-git-commit?
  (upstream-updater-predicate %latest-git-updater))

(define* (make-package directory base-version revision commit
                       #:optional (properties
                                   '((with-latest-git-commit . #true))))
  (dummy-package "test-package"
                 (version (git-version base-version revision commit))
                 (source
                  (origin
                    (method git-fetch)
                    (uri (git-reference
                          (url (string-append "file://" directory))
                          (commit commit)))
                    (sha256 #f)))
                 (properties properties)))

(define (find-commit-as-string repository query)
  (oid->string (commit-id (find-commit repository query))))

(unless (which (git-command)) (test-skip 1))
(test-equal "latest-git: an update"
  '(#true #true #true)
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "First commit")
        (add "b.txt" "B")
        (commit "Second commit"))
    (with-repository directory repository
      (let* ((old-commit
              (find-commit-as-string repository "First commit"))
             (new-commit
              (find-commit-as-string repository "Second commit"))
             (package (make-package directory "1.0" "0" old-commit))
             (update (latest-git-upstream package)))
        (list (with-latest-git-commit? package)
              (string=? (upstream-source-version update)
                        (git-version "1.0" "1" new-commit))
              ;; See 'oid->commit in (guix git) for why not string=?.
              (string-prefix?
               (git-reference-commit (upstream-source-urls update))
               new-commit))))))

(unless (which (git-command)) (test-skip 1))
(test-equal "latest-git: no new commit, no new revision"
  '(#true #true #true)
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "First commit"))
    (with-repository directory repository
      (let* ((commit
              (find-commit-as-string repository "First commit"))
             (package (make-package directory "1.0" "0" commit))
             (update (latest-git-upstream package)))
        ;; 'update' being #false would work as well.
        (list (with-latest-git-commit? package)
              (string=? (upstream-source-version update)
                        (package-version package))
              (string-prefix?
               (git-reference-commit (upstream-source-urls update))
               commit))))))

(unless (which (git-command)) (test-skip 1))
(test-equal "latest-git: non-HEAD commits ignored"
  '(#true #true #true)
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "First commit")
        (tag "let-me-be-head")
        (branch "dev")
        (checkout "dev")
        (add "b.txt" "B")
        (commit "Not ready for distribution!")
        (checkout "let-me-be-head"))
    (with-repository directory repository
      (let* ((commit
              (find-commit-as-string repository "First commit"))
             (package (make-package directory "1.0" "0" commit))
             (update (latest-git-upstream package)))
        (list (with-latest-git-commit? package)
              (string=? (upstream-source-version update)
                        (package-version package))
              (string-prefix?
               (git-reference-commit (upstream-source-urls update))
               commit))))))

(unless (which (git-command)) (test-skip 1))
(test-equal "latest-git: non-HEAD branches can be chosen"
  '(#true #true #true)
  (with-temporary-git-repository directory
      '((checkout "stable-for-distros" orphan)
        (add "a.txt" "A")
        (commit "First commit")
        (add "b.txt" "B")
        (commit "Here's a bugfix.")
        (branch "unstable")
        (checkout "unstable")
        (add "c.txt" "C")
        ;; This commit may not be chosen.
        (commit "New feature, needs more work before distributing."))
    (with-repository directory repository
      (let* ((old-commit
              (find-commit-as-string repository "First commit"))
             (new-commit
              (find-commit-as-string repository "Here's a bugfix"))
             (properties
              '((with-latest-git-commit . "refs/heads/stable-for-distros")))
             (package (make-package directory "1.0" "0" old-commit properties))
             (update (latest-git-upstream package)))
        (list (with-latest-git-commit? package)
              (string=? (upstream-source-version update)
                        (git-version "1.0" "1" new-commit))
              (string-prefix?
               (git-reference-commit (upstream-source-urls update))
               new-commit))))))

(unless (which (git-command)) (test-skip 1))
(test-equal "latest-git: deleted references handled gracefully"
  #false
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "First commit"))
    (with-repository directory repository
      (let* ((properties
              '((with-latest-git-commit . "refs/heads/I-do-not-exist")))
             (package (make-package directory "1.0" "0" "cabba9e" properties)))
        (latest-git-upstream package)))))

(test-equal "with-latest-git-commit?"
  '(#true #false #true #true #false #false)
  (map (lambda (properties)
         (with-latest-git-commit?
          (make-package "/dev/null" "1.0" "0" "cabba9e" properties)))
       (list '((with-latest-git-commit . #true)) ; defaults to HEAD
             '() ; packages have to opt-in, so #false
             '((with-latest-git-commit . "HEAD")) ; explicit HEAD is ok
             '((with-latest-git-commit . "refs/heads/main")) ; another branch
             '((with-latest-git-commit . #xf00ba3)) ; bogus
             '((irrelevant . #true)))))

(test-equal "with-latest-git-commit?: not for other VCS"
  #false
  (with-latest-git-commit?
   (package
     (inherit (make-package "/dev/null" "1.0.0" "0" "cabba9e"))
     (source
      (origin
        (method hg-fetch)
        (uri (hg-reference
              (url "https://foo")
              (changeset "foo")))
        (sha256 #false))))))

(test-equal "with-latest-git-commit?: only if there's source code"
  #false
  (with-latest-git-commit?
   (package
     (inherit (make-package "/dev/null" "1.0.0" "0" "cabba9e"))
     (source #false))))

(test-equal "with-latest-git-commit?: only for git-version"
  #false
  (with-latest-git-commit?
   (package
     (inherit (make-package "/dev/null" "1.0.0" "0" "cabba9e"))
     (version "1.0.0"))))

(test-end "git")