#!/usr/bin/env -S guile --no-auto-compile
!#
;; announce-gen.scm -- Generate a release announcement.
;; Copyright (C) 2025 Ludovic Courtès <ludo@gnu.org>
;;
;; This file is part of the GNU Shepherd.
;;
;; The GNU Shepherd 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.
;;
;; The GNU Shepherd 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 the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.

;; Commentary:
;;
;; Generate the release announcement for a new version, using 'NEWS',
;; 'announcement-template.txt', and ftp.gnu.org as sources.
;;
;; Code:

(use-modules (srfi srfi-1)
             (srfi srfi-71)
             (ice-9 match)
             (ice-9 rdelim)
             (ice-9 regex)
             (ice-9 string-fun)
             (ice-9 textual-ports)
             (web client)
             (web response)
             (gcrypt hash)
             (gcrypt base16))

(define %header-rx
  (make-regexp "^\\* Changes in (version )?([0-9.]+)"))

(define (NEWS->versions port)
  "Return two values: the previous version and the current version as read
from PORT, which is an input port on the 'NEWS' file."
  (let loop ((latest #f))
    (let ((line (read-line port 'concat)))
      (cond ((eof-object? line)
             (error "failed to determine previous and current version"
                    port))
            ((regexp-exec %header-rx line)
             =>
             (lambda (match)
               (if latest
                   (values (match:substring match 2) latest)
                   (loop (match:substring match 2)))))
            (else
             (loop latest))))))

(define* (NEWS-excerpt port version #:optional (indent "  "))
  "Return a NEWS excerpt read from @var{port} for @var{version}."
  (let loop ((collecting? #f)
             (excerpt '()))
    (let ((line (read-line port 'concat)))
      (cond ((eof-object? line)
             (error "failed to find NEWS" port version))
            ((regexp-exec %header-rx line)
             =>
             (lambda (match)
               (if (string=? (match:substring match 2) version)
                   (loop #t '())
                   (if collecting?
                       (string-concatenate-reverse excerpt)
                       (loop #f excerpt)))))
            (else
             (if collecting?
                 (let ((whitespace? (string-null? (string-trim line))))
                   (loop collecting?
                         (if (and (null? excerpt) whitespace?)
                             excerpt
                             (cons (if whitespace?
                                       line
                                       (string-append indent line))
                                   excerpt))))
                 (loop collecting? excerpt)))))))

(define (download+hash url algorithm)
  "Download from @var{url} and return the hash of that for @var{algorithm}."
  (let ((response port (http-get url
                                 #:streaming? #t
                                 #:headers '((user-agent . "GNU Guile")))))
    (unless (= 200 (response-code response))
      (error "download failed" url response))
    (let ((hash (port-hash algorithm port)))
      (close-port port)
      hash)))

(define (download-section version)
  "Return the Download section of the release announcement."
  (define base-url
    "https://ftp.gnu.org/gnu/shepherd/")

  (define url
    (string-append base-url "shepherd-" version ".tar.gz"))

  (define sha1-hash
    (download+hash url (hash-algorithm sha1)))

  (define sha256-hash
    (download+hash url (hash-algorithm sha256)))

  (define signing-key-fingerprint
    "3CE464558A84FDC69DB40CFB090B11993D9AEBB5")

  (string-append "\
  Here are the compressed sources and a GPG detached signature:
    " url "
    " url ".sig

  Here are the SHA1 and SHA256 checksums:

    " (bytevector->base16-string sha1-hash) "  " (basename url) "
    " (bytevector->base16-string sha256-hash) "  " (basename url) "

  Authenticate the code by downloading the corresponding .sig file:

    gpg --verify " (basename url) ".sig

  The signing key can be retrieved with:

    gpg --recv-keys " signing-key-fingerprint "

  As a last resort to find the key, you can try the official GNU
  keyring:

    wget -q https://ftp.gnu.org/gnu/gnu-keyring.gpg
    gpg --keyring gnu-keyring.gpg --verify " (basename url) ".sig

  It is bit-for-bit reproducible from a checkout of the ‘v" version "’ tag of
  the Git repository.
"))

(define (instantiate-template template version previous-version)
  "Replace in @var{template}, a string, any substitution variable (enclosed in
'@' signs)."
  (fold (lambda (substitution text)
          (match substitution
            ((variable thunk)
             (string-replace-substring text
                                       (string-append "@" variable "@")
                                       (thunk)))))
        template
        `(("VERSION" ,(const version))
          ("PREVIOUS_VERSION" ,(const previous-version))
          ("DOWNLOAD" ,(lambda () (download-section version)))
          ("NEWS" ,(lambda ()
                     (call-with-input-file "NEWS"
                       (lambda (port)
                         (NEWS-excerpt port version))))))))


(define main
  (match-lambda*
    ((previous-version version)
     (format (current-error-port)
             "Generating announcement for version ~a (previous version: ~a).~%"
             version previous-version)
     (with-fluids ((%default-port-encoding "UTF-8"))
       (let ((template (call-with-input-file "build-aux/announcement-template.txt"
                         get-string-all)))
         (display (instantiate-template template version previous-version)))))
    (()
     (let ((previous-version version (call-with-input-file "NEWS"
                                       NEWS->versions)))
       (main previous-version version)))))

(apply main (cdr (command-line)))
