<commit_before>#|
 This file is a part of autobuild
 (c) 2015 Shirakumo http://tymoon.eu (<EMAIL>)
 Author: <NAME> <<EMAIL>>
|#

(in-package #:autobuild-server)

(defmacro define-ab-api (name args opts &body body)
  `(define-api ,name ,args ,opts
     (cond ((permitted)
            (or (progn ,@body)
                (if (string= (post/get "browser") "true")
                    (redirect (referer))
                    (api-output NIL))))
           (T
            (if (string= (post/get "browser") "true")
                (redirect (format NIL "~a?error=Not permitted." (cut-get-part (referer))))
                (api-output T :status 403 :message "Not permitted."))))))

(define-ab-api autobuild/project/build/add (project commit) ()
  (when (permitted)
    (let ((project (project project)))
      (when project
        (ensure-build project commit :restore :if-newer))))
  NIL)

(define-ab-api autobuild/project/build/start (project build) ()
  (let ((build (build build project)))
    (when (and build (simple-tasks:task-ready-p build))
      (simple-tasks:schedule-task build *builder*)))
  NIL)

(define-ab-api autobuild/project/build/stop (project build) ()
  (let ((build (build build project)))
    (when (and build (eql :running (status build)))
      (simple-tasks:interrupt-task build NIL)))
  NIL)

(define-ab-api autobuild/project/build/delete (project build) ()
  (let ((build (build build project)))
    (when build
      (destroy build)))
  (if (string= (post/get "browser") "true")
      (redirect #@"/")
      (api-output NIL)))

(define-ab-api autobuild/project/build/log (project build &optional file-position) ()
  (let ((build (build build project))
        (pos (parse-integer (or* file-position "0") :junk-allowed T)))
    (when build
      (multiple-value-bind (text position) (log-contents build pos)
        (api-output
         (alexandria:plist-hash-table
          `(:text ,text :position ,position)))))))

(define-ab-api autobuild/project/build/update-recipe (project build recipe) ()
  (let ((build (build build project)))
    (when (and build recipe)
      (restore build recipe)))
  NIL)

(define-ab-api autobuild/project/build (project build[]) ()
  (api-output
   (alexandria:alist-hash-table
    (loop for commit in build[]
          for build = (build commit project)
          when build
          collect (cons (current-commit build)
                        (alexandria:plist-hash-table
                         `(:status ,(status build)
                           :message ,(current-message build)
                           :start ,(start build)
                           :end ,(end build)
                           :duration ,(duration build))))))))

(define-ab-api autobuild/project/pull (project) ()
  (let ((project (project project)))
    (when project
      (pull project)
      (ensure-build project (current-commit project)
                    :restore :if-newer)))
  NIL)

(define-ab-api autobuild/project/delete (project) ()
  (let ((project (project project)))
    (when project
      (destroy project)))
  NIL)

(define-ab-api autobuild/project/populate (project) ()
  (let ((project (project project)))
    (when project
      (loop for commit in (commits project)
            for i from 0 below 20
            do (ensure-build project commit :restore :if-newer))))
  NIL)

(define-ab-api autobuild/project/clean (project) ()
  (let ((project (project project)))
    (when project
      (clean project)))
  NIL)

(define-ab-api autobuild/project/toggle-watch (project) ()
  (let ((project (project project)))
    (when project
      (setf (watch project) (not (watch project)))))
  NIL)

(define-ab-api autobuild/project/add (remote &optional name branch) ()
  (make-build-project
   (or* name (autobuild::parse-remote-name remote))
   remote :branch (or* branch "master"))
  NIL)

(define-ab-api autobuild/system/load (&optional sample) ()
  (api-output
   (alexandria:plist-hash-table
    `(:cpu-usage ,(cdr (assoc :cpu (system-load:cpu-usages :sample (parse-integer (or* sample "1")))))
      :ram-usage ,(system-load:ram-usage)
      :mem-usage ,(system-load:mem-usage)
      :mem-total ,(system-load:mem-total)
      :mem-free ,(system-load:mem-free)))))

(defun permitted ()
  (or (radiance:config-tree :standalone)
      (let ((user (auth:current)))
        (and user (user:check user (perm :autobuild :admin))))))

(defmethod clip:clip ((project project) field)
  (ecase field
    (name (name project))
    (remote (remote-url project))
    (branch (current-branch project))
    (watch (watch project))
    (builds (builds project))))

(defmethod clip:clip ((build build) field)
  (ecase field
    (status
     (string-downcase (status build)))
    (status-icon
     (case (status build)
       (:created "fa-circle-o")
       (:scheduled "fa-ellipsis-h")
       (:running "fa-cog")
       (:stopping "fa-ellipsis-h")
       (:stopped "fa-times")
       (:completed "fa-check-circle")
       (:errored "fa-exclamation-triangle")))
    (remote
     ;; Implement this ourselves at some point instead of relying on GitHub
     (format NIL "~a/commit/~a" (remote-url (project build)) (current-commit build)))
    (project
     (project build))
    (location
     (uiop:native-namestring
      (uiop:enough-pathname (location build) *base-project-dir*)))
    (commit
     (current-commit build))
    (short-commit
     (current-commit build :short T))
    (message
     (current-message build))
    (short-message
     (let* ((message (current-message build))
            (cutoff (min 80 (or (position #\Newline message) 80))))
       (cond ((< cutoff (length message))
              (format NIL "~a..." (subseq message 0 cutoff)))
             (T message))))
    (duration
     (duration build))
    (duration-formatted
     (if (duration build)
         (autobuild::format-time (duration build))
         "-"))
    (start
     (start build))
    (start-formatted
     (if (start build)
         (autobuild::format-date (start build))
         "-"))
    (end
     (end build))
    (end-formatted
     (if (end build)
         (autobuild::format-date (end build))
         "-"))
    (committed
     (legit:current-age build))
    (committed-formatted
     (autobuild::format-date (legit:current-age build)))
    (log-contents
     (log-contents build))<commit_msg>Fixed end-formatted for special cases.<commit_after>#|
 This file is a part of autobuild
 (c) 2015 Shirakumo http://tymoon.eu (<EMAIL>)
 Author: <NAME> <<EMAIL>>
|#

(in-package #:autobuild-server)

(defmacro define-ab-api (name args opts &body body)
  `(define-api ,name ,args ,opts
     (cond ((permitted)
            (or (progn ,@body)
                (if (string= (post/get "browser") "true")
                    (redirect (referer))
                    (api-output NIL))))
           (T
            (if (string= (post/get "browser") "true")
                (redirect (format NIL "~a?error=Not permitted." (cut-get-part (referer))))
                (api-output T :status 403 :message "Not permitted."))))))

(define-ab-api autobuild/project/build/add (project commit) ()
  (when (permitted)
    (let ((project (project project)))
      (when project
        (ensure-build project commit :restore :if-newer))))
  NIL)

(define-ab-api autobuild/project/build/start (project build) ()
  (let ((build (build build project)))
    (when (and build (simple-tasks:task-ready-p build))
      (simple-tasks:schedule-task build *builder*)))
  NIL)

(define-ab-api autobuild/project/build/stop (project build) ()
  (let ((build (build build project)))
    (when (and build (eql :running (status build)))
      (simple-tasks:interrupt-task build NIL)))
  NIL)

(define-ab-api autobuild/project/build/delete (project build) ()
  (let ((build (build build project)))
    (when build
      (destroy build)))
  (if (string= (post/get "browser") "true")
      (redirect #@"/")
      (api-output NIL)))

(define-ab-api autobuild/project/build/log (project build &optional file-position) ()
  (let ((build (build build project))
        (pos (parse-integer (or* file-position "0") :junk-allowed T)))
    (when build
      (multiple-value-bind (text position) (log-contents build pos)
        (api-output
         (alexandria:plist-hash-table
          `(:text ,text :position ,position)))))))

(define-ab-api autobuild/project/build/update-recipe (project build recipe) ()
  (let ((build (build build project)))
    (when (and build recipe)
      (restore build recipe)))
  NIL)

(define-ab-api autobuild/project/build (project build[]) ()
  (api-output
   (alexandria:alist-hash-table
    (loop for commit in build[]
          for build = (build commit project)
          when build
          collect (cons (current-commit build)
                        (alexandria:plist-hash-table
                         `(:status ,(status build)
                           :message ,(current-message build)
                           :start ,(start build)
                           :end ,(end build)
                           :duration ,(duration build))))))))

(define-ab-api autobuild/project/pull (project) ()
  (let ((project (project project)))
    (when project
      (pull project)
      (ensure-build project (current-commit project)
                    :restore :if-newer)))
  NIL)

(define-ab-api autobuild/project/delete (project) ()
  (let ((project (project project)))
    (when project
      (destroy project)))
  NIL)

(define-ab-api autobuild/project/populate (project) ()
  (let ((project (project project)))
    (when project
      (loop for commit in (commits project)
            for i from 0 below 20
            do (ensure-build project commit :restore :if-newer))))
  NIL)

(define-ab-api autobuild/project/clean (project) ()
  (let ((project (project project)))
    (when project
      (clean project)))
  NIL)

(define-ab-api autobuild/project/toggle-watch (project) ()
  (let ((project (project project)))
    (when project
      (setf (watch project) (not (watch project)))))
  NIL)

(define-ab-api autobuild/project/add (remote &optional name branch) ()
  (make-build-project
   (or* name (autobuild::parse-remote-name remote))
   remote :branch (or* branch "master"))
  NIL)

(define-ab-api autobuild/system/load (&optional sample) ()
  (api-output
   (alexandria:plist-hash-table
    `(:cpu-usage ,(cdr (assoc :cpu (system-load:cpu-usages :sample (parse-integer (or* sample "1")))))
      :ram-usage ,(system-load:ram-usage)
      :mem-usage ,(system-load:mem-usage)
      :mem-total ,(system-load:mem-total)
      :mem-free ,(system-load:mem-free)))))

(defun permitted ()
  (or (radiance:config-tree :standalone)
      (let ((user (auth:current)))
        (and user (user:check user (perm :autobuild :admin))))))

(defmethod clip:clip ((project project) field)
  (ecase field
    (name (name project))
    (remote (remote-url project))
    (branch (current-branch project))
    (watch (watch project))
    (builds (builds project))))

(defmethod clip:clip ((build build) field)
  (ecase field
    (status
     (string-downcase (status build)))
    (status-icon
     (case (status build)
       (:created "fa-circle-o")
       (:scheduled "fa-ellipsis-h")
       (:running "fa-cog")
       (:stopping "fa-ellipsis-h")
       (:stopped "fa-times")
       (:completed "fa-check-circle")
       (:errored "fa-exclamation-triangle")))
    (remote
     ;; Implement this ourselves at some point instead of relying on GitHub
     (format NIL "~a/commit/~a" (remote-url (project build)) (current-commit build)))
    (project
     (project build))
    (location
     (uiop:native-namestring
      (uiop:enough-pathname (location build) *base-project-dir*)))
    (commit
     (current-commit build))
    (short-commit
     (current-commit build :short T))
    (message
     (current-message build))
    (short-message
     (let* ((message (current-message build))
            (cutoff (min 80 (or (position #\Newline message) 80))))
       (cond ((< cutoff (length message))
              (format NIL "~a..." (subseq message 0 cutoff)))
             (T message))))
    (duration
     (duration build))
    (duration-formatted
     (if (duration build)
         (autobuild::format-time (duration build))
         "-"))
    (start
     (start build))
    (start-formatted
     (if (start build)
         (autobuild::format-date (start build))
         "-"))
    (end
     (end build))
    (end-formatted
     (case (end build)
       ((NIL T) "-")
       (T (autobuild::format-date (end build)))))
    (committed
     (legit:current-age build))
    (committed-formatted
     (autobuild::format-date (legit:current-age build)))
    (log-contents
     (log-contents build))
{'fraction_non_alphanumeric': 0.15205231229811708, 'fraction_numerical': 0.002678641771054912, 'mean_word_length': 2.6289308176100628, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1002887', 'n_tokens_mistral': 4036, 'n_tokens_neox': 3933, 'n_words': 1060}