guix-data-service/tests/jobs-load-new-guix-revision.scm

(define-module (tests jobs-load-new-guix-revision)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match)
  #:use-module (squee)
  #:use-module (fibers)
  #:use-module (guix utils)
  #:use-module (guix store)
  #:use-module (guix tests)
  #:use-module (guix-data-service database)
  #:use-module (guix-data-service model git-repository)
  #:use-module (guix-data-service jobs load-new-guix-revision))

(test-begin "jobs-load-new-guix-revision")

(%daemon-socket-uri "/var/empty/doesnotexist")

(with-postgresql-connection
 "test-jobs-load-new-guix-revision"
 (lambda (conn)
   (check-test-database! conn)

   (exec-query conn "TRUNCATE guix_revisions CASCADE")

   (test-equal "select-job-for-commit works"
     #f
     (select-job-for-commit conn "does not exist"))

   (exec-query conn "TRUNCATE guix_revisions CASCADE")
   (exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE")

   (test-equal "test job success"
     #t
     (mock
      ((guix-data-service jobs load-new-guix-revision)
       with-store-connection
       (lambda (f)
         (f 'fake-store-connection)))

      (mock
       ((guix-data-service jobs load-new-guix-revision)
        open-store-connection
        (lambda ()
          'fake-store-connection))

       (mock
        ((guix-data-service jobs load-new-guix-revision)
         channel->source-and-derivations-by-system
         (lambda* (conn channel fetch-with-authentication?
                        #:key parallelism)
           (values
            "/gnu/store/guix"
            '(("x86_64-linux"
               .
               ((manifest-entry-item . "/gnu/store/foo.drv")
                (profile . "/gnu/store/bar.drv")))))))

        (mock
         ((guix-data-service jobs load-new-guix-revision)
          channel-derivations-by-system->guix-store-item
          (lambda (channel-derivations-by-system)
            (values "/gnu/store/test"
                    "/gnu/store/test.drv")))

         (mock
          ((guix-data-service jobs load-new-guix-revision)
           extract-information-from
           (lambda _
             #t))

          (mock
           ((guix-data-service model channel-instance)
            insert-channel-instances
            (lambda (conn guix-revision-id derivations-by-system)
              #t))

           (mock
            ((guix channels)
             channel-news-for-commit
             (lambda (channel commit)
               '()))

           (mock
            ((guix-data-service jobs load-new-guix-revision)
             derivation-file-names->derivation-ids
             (lambda _
               #(1)))

            (mock
             ((guix store)
              add-temp-root
              (lambda _ #f))

             (mock
              ((guix store)
               close-connection
               (lambda _ #f))

              (match (enqueue-load-new-guix-revision-job
                      conn
                      (git-repository-url->git-repository-id conn "test-url")
                      "test-commit"
                      "test-source")
                ((id)
                 (run-fibers
                  (lambda ()
                    (process-load-new-guix-revision-job
                     id #:parallelism 1))
                  #:hz 0
                  #:parallelism 1))))))))))))))

   (exec-query conn "TRUNCATE guix_revisions CASCADE")
   (exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE")

   (test-equal "test build store item failure"
     #f
     (mock
      ((guix-data-service jobs load-new-guix-revision)
       with-store-connection
       (lambda (f)
         (f 'fake-store-connection)))

      (mock
       ((guix-data-service jobs load-new-guix-revision)
        channel->source-and-derivations-by-system
        (lambda* (conn channel fetch-with-authentication?
                       #:key parallelism)
          (values
           "/gnu/store/guix"
           '(("x86_64-linux"
              .
              ((manifest-entry-item . "/gnu/store/foo.drv")
               (profile . "/gnu/store/bar.drv")))))))

       (mock
        ((guix-data-service jobs load-new-guix-revision)
         load-channel-instances
         (lambda (git-repository-id commit
                 channel-derivations-by-system)
           0))

        (mock
         ((guix-data-service jobs load-new-guix-revision)
          channel-derivations-by-system->guix-store-item
          (lambda (channel-derivations-by-system)
            #f))

         (match (enqueue-load-new-guix-revision-job
                 conn
                 (git-repository-url->git-repository-id conn "test-url")
                 "test-commit"
                 "test-source")
           ((id)
            (process-load-new-guix-revision-job id))))))))

   (exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE")

   (test-equal "test extract information failure"
     #f
     (mock
      ((guix-data-service jobs load-new-guix-revision)
       with-store-connection
       (lambda (f)
         (f 'fake-store-connection)))

      (mock
       ((guix-data-service jobs load-new-guix-revision)
        channel->source-and-derivations-by-system
        (lambda* (conn channel fetch-with-authentication?
                       #:key parallelism)
          (values
           "/gnu/store/guix"
           '(("x86_64-linux"
              .
              ((manifest-entry-item . "/gnu/store/foo.drv")
               (profile . "/gnu/store/bar.drv")))))))

       (mock
        ((guix-data-service jobs load-new-guix-revision)
         load-channel-instances
         (lambda (git-repository-id commit
                                    channel-derivations-by-system)
           0))

         (mock
          ((guix-data-service jobs load-new-guix-revision)
           channel-derivations-by-system->guix-store-item
           (lambda (channel-derivations-by-system)
             "/gnu/store/test"))

          (mock
           ((guix-data-service jobs load-new-guix-revision)
            extract-information-from
            (lambda* (conn git-repository-id commit
                           guix-source store-path
                           #:key skip-system-tests?
                           extra-inferior-environment-variables
                           parallelism)
              #f))

           (mock
            ((guix channels)
             channel-news-for-commit
             (lambda (channel commit)
               '()))

            (match (enqueue-load-new-guix-revision-job
                    conn
                    (git-repository-url->git-repository-id conn "test-url")
                    "test-commit"
                    "test-source")
              ((id)
               (process-load-new-guix-revision-job id))))))))))

   (exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE")

   (test-assert "test duplicate job handling"
     (with-postgresql-transaction
      conn
      (lambda (conn)
        (enqueue-load-new-guix-revision-job
         conn
         (git-repository-url->git-repository-id conn "test-url")
         "test-commit"
         "test-source")
        (enqueue-load-new-guix-revision-job
         conn
         (git-repository-url->git-repository-id conn "test-url")
         "test-commit"
         "test-source")
        #t)
      #:always-rollback? #t))))

(test-end)