;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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-challenge)
  #:use-module (guix tests)
  #:use-module (guix hash)
  #:use-module (guix store)
  #:use-module (guix monads)
  #:use-module (guix derivations)
  #:use-module (guix gexp)
  #:use-module (guix scripts challenge)
  #:use-module (guix scripts substitute)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 match))

(define %store
  (open-connection-for-tests))

(define query-path-hash*
  (store-lift query-path-hash))

(define-syntax-rule (test-assertm name exp)
  (test-assert name
    (run-with-store %store exp
                    #:guile-for-build (%guile-for-build))))

(define* (call-with-derivation-narinfo* drv thunk hash)
  (lambda (store)
    (with-derivation-narinfo drv (sha256 => hash)
      (values (run-with-store store (thunk)) store))))

(define-syntax with-derivation-narinfo*
  (syntax-rules (sha256 =>)
    ((_ drv (sha256 => hash) body ...)
     (call-with-derivation-narinfo* drv
       (lambda () body ...)
       hash))))


(test-begin "challenge")

(test-assertm "no discrepancies"
  (let ((text (random-text)))
    (mlet* %store-monad ((drv (gexp->derivation "something"
                                                #~(call-with-output-file
                                                      #$output
                                                    (lambda (port)
                                                      (display #$text port)))))
                         (out -> (derivation->output-path drv)))
      (mbegin %store-monad
        (built-derivations (list drv))
        (mlet %store-monad ((hash (query-path-hash* out)))
          (with-derivation-narinfo* drv (sha256 => hash)
            (>>= (discrepancies (list out) (%test-substitute-urls))
                 (lift1 null? %store-monad))))))))

(test-assertm "one discrepancy"
  (let ((text (random-text)))
    (mlet* %store-monad ((drv (gexp->derivation "something"
                                                #~(call-with-output-file
                                                      #$output
                                                    (lambda (port)
                                                      (display #$text port)))))
                         (out -> (derivation->output-path drv)))
      (mbegin %store-monad
        (built-derivations (list drv))
        (mlet* %store-monad ((hash (query-path-hash* out))
                             (wrong-hash
                              -> (let* ((w (bytevector-copy hash))
                                        (b (bytevector-u8-ref w 0)))
                                   (bytevector-u8-set! w 0
                                                       (modulo (+ b 1) 128))
                                   w)))
          (with-derivation-narinfo* drv (sha256 => wrong-hash)
            (>>= (discrepancies (list out) (%test-substitute-urls))
                 (match-lambda
                   ((discrepancy)
                    (return
                     (and (string=? out (discrepancy-item discrepancy))
                          (bytevector=? hash
                                        (discrepancy-local-sha256
                                         discrepancy))
                          (match (discrepancy-narinfos discrepancy)
                            ((bad)
                             (bytevector=? wrong-hash
                                           (narinfo-hash->sha256
                                            (narinfo-hash bad))))))))))))))))

(test-end)

;;; Local Variables:
;;; eval: (put 'with-derivation-narinfo* 'scheme-indent-function 2)
;;; End:
erminado, python2-ndg-httpsclient, python2-websocket-client)
(python2-rauth, python2-url, python2-s3transfer),
gnu/packages/python-xyz.scm (python2-psutil, python2-serpent)
(python2-humanfriendly, python2-empy, python2-parse-type, python2-polib)
(python2-jsonschema, python2-pystache, python2-cython, python2-numpydoc)
(python2-ipyparallel, python2-traitlets, python2-dbus)
(python2-beautifulsoup4, python2-pep517, python2-flake8, python2-llfuse)
(python2-tlsh, python-file, python2-notebook, python-jupyter-console-minimal)
(python2-contextlib2, python2-promise, python2-anyjson, python2-amqp)
(python2-kombu, python2-billiard, python2-celery, python2-whoosh)
(python2-jellyfish, python-rope, ptpython-2, python2-binaryornot)
(python2-setproctitle, python2-argcomplete, python2-xopen, python2-isort)
(python2-radon, python2-rfc6555, python2-activepapers, python2-send2trash)
(python2-cloudpickle, python2-reparser),
gnu/packages/python.scm (python2-called-python),
gnu/packages/qt.scm (python2-sip, python-pyqt-without-qtwebkit, python2-pyqt)
(python-qscintilla, python-pyqt+qscintilla),
gnu/packages/scanner.scm (sane-backends),
gnu/packages/sdl.scm (guile3.0-sdl2),
gnu/packages/selinux.scm (checkpolicy, libselinux, libsemanage, secilc)
(python-sepolgen, policycoreutils),
gnu/packages/serialization.scm (lua5.1-libmpack, lua5.2-libmpack),
gnu/packages/simulation.scm (fenics),
gnu/packages/statistics.scm (python2-statsmodels),
gnu/packages/texinfo.scm (info-reader),
gnu/packages/wxwidgets.scm (wxwidgets-gtk2, wxwidgets-gtk2-3.1),
gnu/packages/xml.scm (xmlsec-nss),
gnu/packages/xorg.scm (uim-gtk, uim-qt),
guix/build-system/python.scm (package-with-explicit-python)
(strip-python2-variant): Use PACKAGE/INHERIT.
</span></span></td><td>Mark H Weaver</td></tr>
<tr><td><span title='2021-02-02 10:24:26 +0100'>2021-02-02</span></td><td><a href='/guix/commit/gnu/packages/gettext.scm?id=625708b03a37fc2a33c437b8e27856ca76965f43'>gnu: Add mdpo.</a><span class='msg-avail'>...<span class='msg-tooltip'>gnu/packages/gettext.scm (mdpo): New variable.
gnu/packages/python-xyz (python-polib): Update to 1.1.0.

Signed-off-by: Nicolas Goaziou &lt;mail@nicolasgoaziou.fr&gt;
</span></span></td><td>EuAndreh</td></tr>