;;; Guix Build Coordinator
;;;
;;; Copyright © 2021 Christopher Baines <mail@cbaines.net>
;;;
;;; This file is part of the guix-build-coordinator.
;;;
;;; The Guix Build Coordinator 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 Guix Build Coordinator 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 guix-data-service.  If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (guix-build-coordinator agent-messaging local)
  #:use-module (oop goops)
  #:use-module (logging logger)
  #:use-module (lzlib)
  #:use-module (guix serialization)
  #:use-module (guix-build-coordinator datastore)
  #:use-module (guix-build-coordinator coordinator)
  #:use-module (guix-build-coordinator agent-messaging abstract)
  #:export (make-local-agent-interface

            submit-status
            submit-log-file
            submit-build-result
            report-build-start
            report-setup-failure
            submit-output
            fetch-builds-for-agent))

(define-class <local-agent-interface> ()
  (build-coordinator #:init-keyword #:build-coordinator)
  (agent-id #:init-keyword #:agent-id))

(define (make-local-agent-interface build-coordinator agent-id)
  (make <local-agent-interface>
    #:build-coordinator build-coordinator
    #:agent-id agent-id))

(define (default-log level . components)
  (apply log-msg level components))

(define-method (submit-status
                (interface <local-agent-interface>)
                .
                args)
  (apply
   (lambda* (status #:key (log default-log))
     (agent-details (build-coordinator-datastore
                     (slot-ref interface 'build-coordinator))
                    (slot-ref interface 'agent-id)))
   args))

(define-method (submit-output
                (interface <local-agent-interface>)
                .
                args)
  (apply
   (lambda* (build-id output-name file #:key (log default-log))
     (let* ((output-file-name
             (build-output-file-location (build-coordinator-datastore
                                          (slot-ref interface 'datastore))
                                         build-id
                                         output-name))
            (tmp-output-file-name
             (string-append output-file-name ".tmp")))
       (when (file-exists? tmp-output-file-name)
         (delete-file tmp-output-file-name))
       (log 'INFO "compressing " file " -> " tmp-output-file-name)
       (call-with-output-file tmp-output-file-name
         (lambda (out)
           (call-with-lzip-output-port out
             (lambda (port)
               (write-file file port))
             #:level 9)
           (close-port out)))

       (rename-file tmp-output-file-name
                    output-file-name)))
   args))

(define-method (submit-log-file
                (interface <local-agent-interface>)
                .
                args)
  (apply
   (lambda* (build-id file #:key (log default-log))
     (define format
       (cond
        ((string-suffix? ".bz2" file) "bzip2")
        ((string-suffix? ".gz" file)  "gzip")
        (else
         (error "unsupported log format for" file))))

     (let* ((output-file-name
             (build-log-file-destination build-id format)))
       (copy-file file
                  output-file-name)))
   args))

(define-method (submit-build-result
                (interface <local-agent-interface>)
                .
                args)
  (apply
   (lambda* (build-id result #:key (log default-log))
     (handle-build-result (slot-ref interface 'build-coordinator)
                          (slot-ref interface 'agent-id)
                          build-id
                          result))
   args))

(define-method (report-build-start
                (interface <local-agent-interface>)
                .
                args)
  (apply
   (lambda* (build-id #:key (log default-log))
     (handle-build-start-report (slot-ref interface 'build-coordinator)
                                (slot-ref interface 'agent-id)
                                build-id))
   args))

(define-method (report-setup-failure
                (interface <local-agent-interface>)
                .
                args)
  (apply
   (lambda* (build-id report #:key (log default-log))
     (handle-setup-failure-report
      (slot-ref interface 'build-coordinator)
      (slot-ref interface 'agent-id)
      build-id
      report))
   args))

(define-method (fetch-builds-for-agent
                (interface <local-agent-interface>)
                .
                args)
  (apply
   (lambda* (systems target-count #:key (log default-log))
     (fetch-builds (slot-ref interface 'build-coordinator)
                   (slot-ref interface 'agent-id)
                   systems
                   target-count
                   #f))
   args))