;;; GNU Guix --- Functional package management for GNU
;;;
;;; 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/>.

;;; TODOs:
;;; 1. Support non-git root repositories
;;; 2. Store/cache individual module downloads

(define-module (guix go-mod-download)
  #:use-module (guix build utils)
  #:use-module (guix derivations)
  #:use-module (guix packages)
  #:use-module (guix gexp)
  #:use-module (guix modules)
  #:use-module (guix monads)
  #:use-module (guix records)
  #:use-module (guix store)
  #:use-module (guix git-download)

  #:export (go-mod-reference
            go-mod-reference?
            go-mod-source
            go-mod-go

            go-mod-fetch))

(define (go-package)
  "Return the default Go package."
  (let ((distro (resolve-interface '(gnu packages golang))))
    (module-ref distro 'go)))

(define (nss-certs-package)
  "Return the default nss-certs package."
  (let ((distro (resolve-interface '(gnu packages certs))))
    (module-ref distro 'nss-certs)))

;; The source key accepts the same kinds as the package record, but mostly go
;; use git.  The go key specifies which go version to use, which might be
;; necessary if any module sets a newer toolchain in go.mod
(define-record-type* <go-mod-reference>
  go-mod-reference make-go-mod-reference
  go-mod-reference?
  (source go-mod-source)
  (go go-mod-go (default (go-package)) (thunked)))

;; Fetch all direct and indirect dependencies of the go modules in the source
;; tree (usually a git repo) using go mod download.
(define* (go-mod-fetch source hash-algo hash
                       #:optional name
                       #:key (system (%current-system))
                       (guile (default-guile))
                       (go (go-package))
                       (nss-certs (nss-certs-package)))
  (define guile-json
    (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4))

  (define* (build source go)
    (with-imported-modules (source-module-closure
                            '((guix build utils)
                              (guix build download)
                              (srfi srfi-34)))
      (with-extensions (list guile-json)
        #~(begin
            (use-modules
             (guix build download)
             (guix build utils)
             (srfi srfi-34))
            (let* ((cert-dir (string-append #$nss-certs "/etc/ssl/certs"))
                   (src-dir (string-append #$output "/source"))
                   (mod-cache (string-append #$output "/go/pkg"))
                   (xgo (string-append #$go "/bin/go")))
              ;; go.mod files can specify a minimum required toolchain which could
              ;; cause go mod download to fetch and install a newer compiler
              ;; if invoked with an older one.
              (setenv "GOTOOLCHAIN" (string-append "go" (getenv "go toolchain")))
              (setenv "SSL_CERT_DIR" cert-dir)
              (setenv "GOCACHE" "/homeless-shelter")
              (setenv "GOPATH" "/homeless-shelter")
              (setenv "GOMODCACHE" mod-cache)

              (mkdir-p src-dir)
              (mkdir-p mod-cache)
              (copy-recursively #$source src-dir)
              (let* ((go-mods (find-files src-dir "go.mod")))
                ;; go mod will update the go.mod with transitive dependencies if
                ;; they are not set, and fail with an error if the file is not
                ;; writable.
                (for-each make-file-writable go-mods)
                (with-throw-handler
                    #t
                  (lambda _
                    (for-each
                     (lambda (go-mod)
                       (with-directory-excursion (dirname go-mod)
                         ;; go mod download must be run twice - the first
                         ;; fetches direct dependencies and *records*
                         ;; transitive dependencies, the second run fetches
                         ;; the transitive dependencies.
                         (and
                          (invoke xgo "mod" "download")
                          (invoke xgo "mod" "download"))))
                     go-mods)
                    #t)
                  (lambda (key . args)
                    (display (string-append "Fetching modules failed.\n"
                                            "Here are the results of `go env`:\n"))
                    (invoke xgo "env")))))))))

  (let* ((mod-source (go-mod-source source))
         (mod-ref  (origin-uri mod-source))
         (mod-go (go-mod-go source))
         (mod-hash (origin-hash mod-source))
         (mod-hash-value (content-hash-value mod-hash))
         (mod-hash-algo (content-hash-algorithm mod-hash)))

  (mlet* %store-monad ((guile-for-build (package->derivation guile system))
                       (git-source (git-fetch mod-ref mod-hash-algo
                                              mod-hash-value
                                              #:system system
                                              #:guile guile-for-build)))
    (gexp->derivation (or name "go-mod-fetch") (build git-source mod-go)
                      #:script-name "go-mod-fetch"
                      #:env-vars
                      `(("go toolchain" . ,(package-version mod-go)))
                      #:leaked-env-vars '("http_proxy" "https_proxy"
                                          "LC_ALL" "LC_MESSAGES" "LANG"
                                          "COLUMNS")
                      #:system system
                      #:local-build? #t ;don't offload repo cloning
                      #:recursive? #t
                      #:hash-algo hash-algo
                      #:hash hash
                      #:guile-for-build guile-for-build))))