;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019-2021, 2024 Ludovic Courtès ;;; ;;; 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 . (define-module (test-swh) #:use-module (guix swh) #:use-module (guix base32) #:use-module (guix tests http) #:use-module (web response) #:use-module (srfi srfi-19) #:use-module (srfi srfi-64) #:use-module (ice-9 match)) ;; Test the JSON mapping machinery used in (guix swh). (define %origin "{ \"origin_visits_url\": \"/visits/42\", \"type\": \"git\", \"url\": \"http://example.org/guix.git\" }") (define %visits ;; A single visit where 'snapshot_url' is null. ;; See . "[ { \"origin\": \"https://github.com/Genivia/ugrep\", \"visit\": 1, \"date\": \"2020-05-17T21:43:45.422977+00:00\", \"status\": \"ongoing\", \"snapshot\": null, \"metadata\": {}, \"type\": \"git\", \"origin_visit_url\": \"https://archive.softwareheritage.org/api/1/origin/https://github.com/Genivia/ugrep/visit/1/\", \"snapshot_url\": null } ]") (define %directory-entries "[ { \"name\": \"one\", \"type\": \"regular\", \"length\": 123, \"dir_id\": 1 }, { \"name\": \"two\", \"type\": \"regular\", \"length\": 456, \"dir_id\": 2 } ]") (define %external-id "{ \"extid_type\": \"nar-sha256\", \"extid\": \"0b56ba94c2b83b8f74e3772887c1109135802eb3e8962b628377987fe97e1e63\", \"version\": 0, \"target\": \"swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153\", \"target_url\": \"https://archive.softwareheritage.org/swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153\" }") (define-syntax-rule (with-json-result str exp ...) (with-http-server `((200 ,str)) (parameterize ((%swh-base-url (%local-url))) exp ...))) (test-begin "swh") (test-equal "lookup-origin" (list "git" "http://example.org/guix.git") (with-json-result %origin (let ((origin (lookup-origin "http://example.org/guix.git"))) (list (origin-type origin) (origin-url origin))))) (test-equal "lookup-origin, not found" #f (with-http-server `((404 "Nope.")) (parameterize ((%swh-base-url (%local-url))) (lookup-origin "http://example.org/whatever")))) (test-equal "origin-visit, no snapshots" '("https://github.com/Genivia/ugrep" "2020-05-17T21:43:45Z" #f) ;see (with-http-server `((200 ,%origin) (200 ,%visits)) (parameterize ((%swh-base-url (%local-url))) (let ((origin (lookup-origin "http://example.org/whatever"))) (match (origin-visits origin) ((visit) (list (visit-origin visit) (date->string (visit-date visit) "~4") (visit-snapshot-url visit)))))))) (test-equal "lookup-directory" '(("one" 123) ("two" 456)) (with-json-result %directory-entries (map (lambda (entry) (list (directory-entry-name entry) (directory-entry-length entry))) (lookup-directory "123")))) (test-equal "lookup-origin-revision" '("cd86c72084993d9ef26fc9e24b73cea612b8c97b" "d173c707ee88e3c89401ad77fafa65fcd9e9f5be") (let () ;; Make sure that 'lookup-origin-revision' does the job, and in particular ;; that it doesn't stop until it has found an actual revision: ;; 'git-checkout visits point to directories instead of revisions. ;; See . (define visits ;; Two visits of differing types: the first visit (type 'git-checkout') ;; points to a directory, the second one (type 'git') points to a ;; revision. "[ { \"origin\": \"https://example.org/repo.git\", \"visit\": 1, \"type\": \"git-checkout\", \"date\": \"2020-05-17T21:43:45.422977+00:00\", \"status\": \"full\", \"metadata\": {}, \"type\": \"git-checkout\", \"origin_visit_url\": \"/visit/42\", \"snapshot_url\": \"/snapshot/1\" }, { \"origin\": \"https://example.org/repo.git\", \"visit\": 2, \"type\": \"git\", \"date\": \"2020-05-17T21:43:49.422977+00:00\", \"status\": \"full\", \"metadata\": {}, \"type\": \"git\", \"origin_v2021-01-08gnu: monero-gui: Update to 0.17.1.9....* gnu/packages/finance.scm (monero-gui): Update to 0.17.1.9. [source]: Fetch submodules. Add snippet to remove embedded monero sources. Guillaume Le Vaillant 2021-01-08gnu: monero: Update to 0.17.1.9....* gnu/packages/finance.scm (monero): Update to 0.17.1.9. Guillaume Le Vaillant 2021-01-08gnu: Add schmutz....* gnu/packages/guile-xyz.scm (schmutz): New variable. Ricardo Wurmus 2021-01-08gnu: rust-pin-utils-0.1: Deduplicate duplicate definitions....* gnu/packages/crates-io.scm (rust-pin-utils-0.1): Combine duplicate definitions. Efraim Flashner 2021-01-08gnu: Add cl-markdown....* gnu/packages/lisp-xyz.scm (cl-markdown, ecl-cl-markdown, sbcl-cl-markdown): New variables. Signed-off-by: Guillaume Le Vaillant <glv@posteo.net> Sharlatan Hellseher 2021-01-08gnu: Add cl-dynamic-classes....* gnu/packages/lisp-xyz.scm (cl-dynamic-classes, ecl-dynamic-classes, sbcl-dynamic-classes): New variables. Signed-off-by: Guillaume Le Vaillant <glv@posteo.net> Sharlatan Hellseher 2021-01-08gnu: sequoia: Update to 1.0.0....* gnu/packages/sequoia.scm (sequoia): Update to 1.0.0. [arguments]{cargo-inputs}: Add rust-eax, rust-futures-util, rust-sha1collisiondetection, rust-socket2. Update rust-capnp, rust-capnp-rpc, rust-capnpc, rust-futures, rust-http,rust-hyper rust-hyper-tls, rust-tokio, rust-win-crypto-ng. Hartmut Goebel 2021-01-08gnu: rust-socket2: Update to 0.3.19....* gnu/packages/crates-io.scm (rust-socket2): Update to 0.3.19. [arguments]{cargo-inputs}: Remove rust-redox-syscall. Hartmut Goebel 2021-01-08g