diff --git a/src/main/gitlab/export.lisp b/src/main/gitlab/export.lisp
index 171d598..e926df1 100644
--- a/src/main/gitlab/export.lisp
+++ b/src/main/gitlab/export.lisp
@@ -1,1161 +1,1177 @@
(in-package #:forgerie-gitlab)
(define-condition unknown-note-mapping
nil
((mapping :initarg :mapping :reader unknown-note-mapping-mapping)))
(defvar *note-mapping-skips* nil)
(defvar *notes-mode* nil)
(defvar *files-to-upload* nil)
(defun validate-vc-repositories (vc-repositories projects)
(let
((valid-projects
(mapcar
(lambda (proj)
(let
((repos-for-proj (forgerie-core:vc-repositories-with-primary-project proj vc-repositories)))
(cond
((< 1 (length repos-for-proj))
(forgerie-core:add-mapping-error
:gitlab-project-primary-in-multiple
(forgerie-core:project-name proj)
(format nil
"Project ~A is the primary project in multiple repositories, and those repositories won't be included:~%~{ * ~A~%~}"
(forgerie-core:project-name proj)
(mapcar #'forgerie-core:vc-repository-name repos-for-proj)))
nil)
(proj))))
projects)))
(remove
nil
(mapcar
(lambda (vcr)
(cond
((cl-ppcre:scan "[,()/+]" (forgerie-core:vc-repository-name vcr))
(forgerie-core:add-mapping-error
:gitlab-repository-has-illegal-name
(forgerie-core:vc-repository-name vcr)
(format nil "VC Repository '~A' has an illegal name due to an illegal character, one of: ',()/+'." (forgerie-core:vc-repository-name vcr))))
((cl-ppcre:scan "^ " (forgerie-core:vc-repository-name vcr))
(forgerie-core:add-mapping-error
:gitlab-repository-has-illegal-name
(forgerie-core:vc-repository-name vcr)
(format nil "VC Repository '~A' has an illegal name due to starting with a space." (forgerie-core:vc-repository-name vcr))))
((not (forgerie-core:vc-repository-primary-projects vcr))
(forgerie-core:add-mapping-error
:gitlab-repository-has-no-projects
(forgerie-core:vc-repository-name vcr)
(format nil "VC Repository '~A' has no primary projects.~%" (forgerie-core:vc-repository-name vcr)))
vcr)
((not (forgerie-core:vc-repository-commits vcr))
(forgerie-core:add-mapping-error
:source-repository-has-no-commits
(forgerie-core:vc-repository-name vcr)
(format nil "Source Repository '~A' has no commits.~%" (forgerie-core:vc-repository-name vcr)))
vcr)
((not
(remove-if-not
(lambda (proj) (find proj valid-projects :test #'equalp))
(forgerie-core:vc-repository-primary-projects vcr)))
nil)
(vcr)))
vc-repositories))))
(defun validate-user (user)
(cond
((< (length (forgerie-core:user-username user)) 2)
(forgerie-core:add-mapping-error
:gitlab-username-too-short
(forgerie-core:user-username user)
(format nil "User '~A' (~{~A~^,~}) has too short of a username."
(forgerie-core:user-username user)
(mapcar #'forgerie-core:email-address (forgerie-core:user-emails user)))))
(user)))
(defun validate-users (users)
(remove nil
(mapcar #'validate-user users)))
(defun ticket-assignable-vc-repositories (ticket vc-repositories)
(when (forgerie-core:ticket-projects ticket)
(remove
nil
(remove-duplicates
(apply #'append
(mapcar
(lambda (proj) (forgerie-core:vc-repositories-with-primary-project proj vc-repositories))
(forgerie-core:ticket-projects ticket)))
:test #'equalp))))
; This assumes that validate-vc-repositories passed, which is to say
; that every project of interest belongs to only one repository, and that
; every vc-repository has at least one primary project
(defun validate-tickets (tickets vc-repositories)
(remove
nil
(mapcar
(lambda (ticket)
(let
((vc-repos (ticket-assignable-vc-repositories ticket vc-repositories)))
(cond
((not vc-repos)
(forgerie-core:add-mapping-error
:gitlab-ticket-assigned-to-default
(forgerie-core:ticket-id ticket)
(format nil "Ticket with id ~A is not assignable to a repository, so assigning to default" (forgerie-core:ticket-id ticket)))
ticket)
((< 1 (length vc-repos))
(forgerie-core:add-mapping-error
:gitlab-ticket-assigned-to-multiple
(forgerie-core:ticket-id ticket)
(format nil
"Ticket with id ~A is assignable to multiple repositories:~%~{ * ~A~%~}"
(forgerie-core:ticket-id ticket)
(mapcar #'forgerie-core:vc-repository-name vc-repos)))
nil)
(ticket))))
tickets)))
(defun validate-merge-requests (merge-requests vc-repositories)
(remove
nil
(mapcar
(lambda (mr)
(if
(not
(find
(forgerie-core:vc-repository-slug (forgerie-core:merge-request-vc-repository mr))
vc-repositories :test #'string= :key #'forgerie-core:vc-repository-slug))
(forgerie-core:add-mapping-error
:gitlab-merge-request-not-assignable
(forgerie-core:merge-request-id mr)
(format nil "Merge Request with title ~A is not assignable to a repository~%" (forgerie-core:merge-request-title mr)))
mr))
merge-requests)))
; We only cache this in memory, and not on disk, because we most likely want
; updated information any time a run is fresh.
(defvar *projects-by-slug* nil)
(defvar *projects-by-name* nil)
(defvar *projects-by-id* nil)
(defun find-gitlab-project (repo)
(let ((slug (forgerie-core:vc-repository-slug repo)))
(when (not (assoc slug *projects-by-slug* :test #'string=))
(let*
((namespace-path (namespace-for-repo repo))
(namespace-id
(cond
(namespace-path
(mapped-item-id (find-mapped-item :group namespace-path)))
(*default-group*
(mapped-item-id (find-mapped-item :group :default-group)))))
(project-path (format nil "~A/~A" (or namespace-path (getf *default-group* :path)) slug))
(project (handler-case
(get-request (format nil "projects/~A" (quri:url-encode project-path)))
(http-error (e) nil))))
(setf *projects-by-slug* (cons (cons slug project) *projects-by-slug*))
(setf *projects-by-name* (cons (cons (getf project :name) project) *projects-by-name*))
(setf *projects-by-id* (cons (cons (getf project :id) project) *projects-by-id*))))
(cdr (assoc slug *projects-by-slug* :test #'string=))))
(defun find-project-by-name (name)
(when (not (assoc name *projects-by-name* :test #'string=))
(let
((project
(find
name
(get-request "projects" :parameters `(("search" . ,name)))
:test #'string=
:key (lambda (gl-project) (getf gl-project :name)))))
(setf *projects-by-name* (cons (cons name project) *projects-by-name*))
(setf *projects-by-slug* (cons (cons (getf project :slug) project) *projects-by-slug*))
(setf *projects-by-id* (cons (cons (getf project :id) project) *projects-by-id*))))
(cdr (assoc name *projects-by-name* :test #'string=)))
(defun find-project-by-id (id)
(when (not (assoc id *projects-by-id*))
(let
((project (get-request (format nil "projects/~A" id))))
(setf *projects-by-slug* (cons (cons (getf project :slug) project) *projects-by-slug*))
(setf *projects-by-id* (cons (cons (getf project :id) project) *projects-by-id*))))
(cdr (assoc id *projects-by-id*)))
(defun default-project ()
(when *default-project*
(find-project-by-name (getf *default-project* :name))))
(defun create-default-project ()
(when *default-project*
(when-unmapped-with-update (:project :default-project)
(let
((project-on-gitlab
(handler-case
(get-request (format nil "projects/~A"
(quri:url-encode (format nil "~A/~A"
(getf *default-group* :path)
(getf *default-project* :path)))))
(http-error (e) nil))))
(or
project-on-gitlab
(post-request
"projects"
(append
(when *default-group*
(list
(cons
"namespace_id"
(princ-to-string (getf (first (get-request "namespaces" :parameters `(("search" . ,(getf *default-group* :name))))) :id)))))
`(("name" . ,(getf *default-project* :name))
("issues_access_level" . "enabled")
("snippets_access_level" . "enabled")
("repository_access_level" . "disabled")
("auto_devops_enabled" . "false")
("wiki_access_level" . "disabled")
("requirements_access_level" . "disabled")
("pages_access_level" . "disabled")
("packages_enabled" . "false")
("operations_access_level" . "disabled")
("container_registry_access_level" . "disabled")
("visibility" . "public")
("path" . ,(getf *default-project* :path))))))))))
(defun default-group ()
(when *default-group*
(get-request
"groups"
:parameters `(("search" . ,(getf *default-group* :name))))))
(defun create-default-group ()
(when *default-group*
(when-unmapped-with-update (:group :default-group)
(let
((group-on-gitlab
(handler-case
(get-request (format nil "groups/~A" (quri:url-encode (getf *default-group* :path))))
(http-error (e) nil))))
(or
group-on-gitlab
(post-request
"groups"
`(("name" . ,(getf *default-group* :name))
("path" . ,(getf *default-group* :path))
("visibility" . "public"))))))))
(defun create-groups ()
(when *group-structure*
(mapcar
(lambda (group)
(let*
((parent-group-id
(if (getf group :parent)
(mapped-item-id (find-mapped-item :group (getf group :parent)))))
(full-path
(if (getf group :parent)
(concatenate 'string (getf group :parent) "/" (getf group :path))
(getf group :path))))
(when-unmapped-with-update (:group full-path)
(let
((group-on-gitlab
(handler-case
(get-request (format nil "groups/~A" (quri:url-encode full-path)))
(http-error (e) nil))))
(or
group-on-gitlab
(post-request
"groups"
`(("name" . ,(getf group :name))
("path" . ,(getf group :path))
("parent_id" . ,parent-group-id) ;; This works fine even if parent-group-id is nil
("visibility" . "public"))))))))
*group-structure*)))
(defun normalize-pubkey (pubkeystr)
"Compare ssh keys using algo and hash (first two words), ignoring key title"
(let ((split (uiop:split-string pubkeystr)))
(uiop:reduce/strcat (subseq split 0 2))))
(defun gitlab-key-matches (key)
(string=
(normalize-pubkey *ssh-public-key*)
(normalize-pubkey (getf key :key))))
(defun add-ssh-key ()
(when-unmapped-with-update (:forgerie-key :main-key)
(let*
((key-name (format nil "Forgerie Export Key ~a" (local-time:now)))
(known-keys (get-request "user/keys"))
(key-found (find-if #'gitlab-key-matches known-keys)))
(if key-found
key-found
(post-request
"user/keys"
`(("title" . ,key-name)
("key" . ,*ssh-public-key*)))))))
(defun project-for-ticket (ticket vc-repositories)
(let
((vc-repos (ticket-assignable-vc-repositories ticket vc-repositories)))
(if vc-repos
(find-gitlab-project (car vc-repos))
(when (not (getf *default-project* :disable-tickets)) (default-project)))))
(defun remove-single-project ()
(when *single-project*
(let
((project (find-project-by-name *single-project*)))
(when project
(cl-fad:delete-directory-and-files
(format nil "~A~A/" *working-directory* (getf project :path))
:if-does-not-exist :ignore)
(delete-request (format nil "/projects/~A" (getf project :id)))
(setf *projects-by-name* nil)
; Gitlab returns immediately even though the project is being deleted....
(sleep 60)))))
(defmethod forgerie-core:export-forge ((forge (eql :gitlab)) data)
(setf *working-directory* (format nil "~Agitlab/" forgerie-core:*working-directory*))
(forgerie-core:check-for-stop)
(ensure-directories-exist *working-directory*)
(when *single-project* (remove-single-project))
(create-groups)
(create-default-group)
(create-default-project)
(add-ssh-key)
(let*
((*note-mapping-skips* nil)
(*notes-mode* nil)
(*files-to-upload* (getf data :files))
(vc-repositories (validate-vc-repositories (getf data :vc-repositories) (getf data :projects)))
(tickets (remove-if-not #'identity (validate-tickets (getf data :tickets) vc-repositories)))
(merge-requests (validate-merge-requests (getf data :merge-requests) vc-repositories)))
(mapcar (lambda (user) (update-user-admin-status user t)) (validate-users (getf data :users)))
(if *limit-to-active-users*
; Only add admins if we're limiting
(mapcar #'create-user (remove-if-not #'forgerie-core:user-admin (validate-users (getf data :users))))
(mapcar #'create-user (validate-users (getf data :users))))
(mapcar #'create-project vc-repositories)
(loop
:with moved-forward := t
:with completed := nil
:with first-error := nil
:with number-of-errors := 0
:while moved-forward
:do
(flet
((map-with-note-mapping-catch (fn collection)
(mapcar
(lambda (item)
(let
((item-info
(list
(type-of item)
(typecase item
(forgerie-core:ticket (forgerie-core:ticket-id item))
(forgerie-core:merge-request (forgerie-core:merge-request-id item))
(forgerie-core:snippet (forgerie-core:snippet-id item))))))
(when (not (find item completed :test #'equalp))
(handler-case
(progn
(funcall fn item)
(setf moved-forward t)
(setf completed (cons item completed)))
(unknown-note-mapping (e)
(incf number-of-errors)
(when (not first-error) (setf first-error (unknown-note-mapping-mapping e))))))))
collection)))
(setf moved-forward nil)
(setf first-error nil)
(setf number-of-errors 0)
(map-with-note-mapping-catch (lambda (ticket) (create-ticket ticket vc-repositories)) tickets)
(map-with-note-mapping-catch #'create-snippet (getf data :snippets))
(map-with-note-mapping-catch #'create-merge-request merge-requests)
(when (and (not first-error) (not *notes-mode*))
(setf *notes-mode* t)
(setf completed nil)
(setf moved-forward t))
(when (and (not moved-forward) first-error)
(when forgerie-core:*debug* (format t "We failed to move forward...., so skipping item ~A~%" first-error))
(setf moved-forward t)
(push first-error *note-mapping-skips*))))
(mapcar (lambda (ticket) (create-ticket-links ticket vc-repositories)) tickets)
(mapcar #'add-commit-comments vc-repositories)
(mapcar #'update-user-admin-status (validate-users (getf data :users)))))
(defun add-commit-comments (vc-repository)
(single-project-check (forgerie-core:vc-repository-name vc-repository)
(let
((project (find-gitlab-project vc-repository)))
(mapcar
(lambda (commit)
(let*
((comment (forgerie-core:commit-parsed-comment commit))
(mappings
(remove-if-not
(lambda (item)
(and
(listp item)
(find (car item) (list :ticket :merge-request :snippet))
(find-mapped-item (car item) (parse-integer (cadr item)))))
comment))
(body
(when mappings
(format nil "Commit comment has updated locations:~%~%~{* ~A is now ~A~%~}"
(apply #'append
(mapcar
(lambda (item)
(let
((mi (find-mapped-item (car item) (parse-integer (cadr item))))
(c
(cond
((eql :ticket (car item)) "#")
((eql :merge-request (car item)) "!")
((eql :snippet (car item)) "$"))))
(list
(caddr item)
(if (equal (getf project :id) (mapped-item-project-id mi))
(format nil "~A~A" c (or (mapped-item-iid mi) (mapped-item-id mi)))
(let
((other-project (find-project-by-id (mapped-item-project-id mi))))
(format nil "~A~A~A" (getf other-project :path) c (or (mapped-item-iid mi) (mapped-item-id mi))))))))
mappings))))))
(when body
(when-unmapped (:commit-comment (forgerie-core:commit-sha commit))
(let
((commit-in-gitlab
(get-request (format nil "/projects/~A/repository/commits/~A" (getf project :id) (forgerie-core:commit-sha commit)))))
(post-request
(format nil "/projects/~A/repository/commits/~A/discussions" (getf project :id) (forgerie-core:commit-sha commit))
`(("body" . ,body)
("created_at" . ,(getf commit-in-gitlab :created_at)))))
(update-mapping (:commit-comment (forgerie-core:commit-sha commit)))))))
(forgerie-core:vc-repository-commits vc-repository)))))
; Projects are created from vc repositories, since they are linked in gitlab.
; Some of the underlying information comes from core:projects that are
; the primary projects of the vc-repository
(defun create-project (vc-repository)
(single-project-check (forgerie-core:vc-repository-name vc-repository)
(when-unmapped (:project (forgerie-core:vc-repository-slug vc-repository))
(let*
((tags
(remove-duplicates
(apply #'append
(mapcar #'forgerie-core:project-tags (forgerie-core:vc-repository-projects vc-repository)))
:test #'string=))
(namespace-path (namespace-for-repo vc-repository))
(namespace-id
(cond
(namespace-path
(mapped-item-id (find-mapped-item :group namespace-path)))
(*default-group*
(mapped-item-id (find-mapped-item :group :default-group)))))
(gl-project-path (format nil "~A/~A" (or namespace-path (getf *default-group* :path)) (forgerie-core:vc-repository-slug vc-repository)))
(gl-project-get (handler-case
(get-request (format nil "projects/~A" (quri:url-encode gl-project-path)))
(http-error (e) nil)))
(gl-project
(or
gl-project-get
(post-request
"projects"
`(("name" . ,(forgerie-core:vc-repository-name vc-repository))
("path" . ,(forgerie-core:vc-repository-slug vc-repository))
("tag_list" . ,(format nil "~{~A~^,~}" tags))
("issues_access_level" . "enabled")
("visibility" . ,(if (forgerie-core:vc-repository-private vc-repository) "private" "public"))
("merge_requests_access_level" . "enabled")
("auto_devops_enabled" . "false")
("wiki_access_level" . "disabled")
("requirements_access_level" . "disabled")
("pages_access_level" . "disabled")
("packages_enabled" . "false")
("operations_access_level" . "disabled")
("container_registry_access_level" . "disabled")
("namespace_id" . ,namespace-id)))))
(working-path (format nil "~A~A/" *working-directory* (getf gl-project :path))))
(when
(getf gl-project :empty_repo)
(when (not (probe-file working-path))
(ensure-directories-exist working-path)
(git-cmd gl-project "clone" "--mirror" (forgerie-core:vc-repository-git-location vc-repository) ".")
(git-cmd gl-project "remote" "add" "gitlab" (getf gl-project :ssh_url_to_repo)))
(git-cmd gl-project "remote" "set-url" "gitlab" (getf gl-project :ssh_url_to_repo))
(git-cmd gl-project "push" "gitlab" "--all")
(git-cmd gl-project "push" "gitlab" "--tags")
(uiop/filesystem:delete-directory-tree (pathname working-path) :validate t)
(update-mapping (:project (forgerie-core:vc-repository-slug vc-repository)) gl-project))))))
(defun update-event-date (obj-type obj-id new-date &key extra-filter)
(let
((find-ev-command
(format nil "ev = Event.where(:target => ~A, :target_type => '~A')~@[~A~].order_by(:created_at => 'DESC').first"
obj-id obj-type extra-filter)))
(rails-commands-with-recovery
(list
(format nil "action_time = Time.parse(\"~A\")" (to-iso-8601 new-date))
(format nil "~A; begin sleep(0.1); ~A end while !ev" find-ev-command find-ev-command)
"ev.created_at = action_time"
"ev.updated_at = action_time"
"ev.save"))))
(defun process-note-text (note-text project-id)
(format nil "~{~A~}"
(mapcar
(lambda (item)
(flet
((mapped-item-p (item type) (and (eql type (car item)) (find-mapped-item type (parse-integer (cadr item)))))
(handle-mapped-item (item type c)
(let
((mi (find-mapped-item type (parse-integer (cadr item)))))
(if (equal project-id (mapped-item-project-id mi))
(format nil "~A~A" c (or (mapped-item-iid mi) (mapped-item-id mi)))
(let
((other-project (find-project-by-id (mapped-item-project-id mi))))
(format nil "~A~A~A" (getf other-project :path) c (or (mapped-item-iid mi) (mapped-item-id mi)))))))
(handle-file (file-id)
(let
((file-response (create-file file-id project-id)))
(getf file-response :markdown))))
(cond
((stringp item) item)
((eql (car item) :file) (handle-file (cadr item)))
((eql (car item) :h1) (format nil "~%# ~A~%" (cadr item)))
((eql (car item) :h2) (format nil "~%## ~A~%" (cadr item)))
((eql (car item) :h3) (format nil "~%### ~A~%" (cadr item)))
((eql (car item) :h4) (format nil "~%#### ~A~%" (cadr item)))
((eql (car item) :h5) (format nil "~%##### ~A~%" (cadr item)))
((eql (car item) :link) (format nil "[~A](~A)" (cadr (cadr item)) (car (cadr item))))
((mapped-item-p item :ticket) (handle-mapped-item item :ticket "#"))
((mapped-item-p item :merge-request) (handle-mapped-item item :merge-request "!"))
((mapped-item-p item :snippet) (handle-mapped-item item :snippet "$"))
((find item *note-mapping-skips* :test #'equalp)
(caddr item))
(*notes-mode* (caddr item))
(t (error (make-instance 'unknown-note-mapping :mapping item))))))
note-text)))
(defun create-note (project-id item-type item-id note)
(when *notes-mode*
(let
((note-text (process-note-text (forgerie-core:note-text note) project-id)))
(when
(not (cl-ppcre:scan "^\\s*$" note-text))
(when-unmapped-with-update (:note (forgerie-core:note-id note))
(let
((created-note
(post-request
(format nil "/~A~A/~A/notes"
(if project-id (format nil "projects/~A/" project-id) "") item-type item-id)
`(("body" . ,note-text)
("created_at" . ,(to-iso-8601 (forgerie-core:note-date note))))
:sudo (forgerie-core:user-username (ensure-user-created (forgerie-core:note-author note))))))
(update-event-date "Note" (getf created-note :id) (forgerie-core:note-date note))
created-note))))))
+(defvar *file-transfer-temporary-dir* nil)
+
(defun create-file (file-id project-id)
(let
((file (find (parse-integer file-id) *files-to-upload* :key #'forgerie-core:file-id)))
(when (not file)
(error (format nil "Couldn't find file to upload with id ~S" (parse-integer file-id))))
- (when-unmapped (:file-upoaded (forgerie-core:file-id file))
- (update-file-mapping (:file-upoaded (forgerie-core:file-id file))
- (post-request
- (format nil "projects/~A/uploads" project-id)
- `(("file" . ,(pathname (forgerie-core:file-location file)))
- ("filename" . ,(quri:url-encode (forgerie-core:file-name file)))))))
- (retrieve-mapping :file-upoaded (forgerie-core:file-id file))))
+ (when-unmapped (:file-uploaded (forgerie-core:file-id file))
+ (update-file-mapping (:file-uploaded (forgerie-core:file-id file))
+ (progn
+ (unless *file-transfer-temporary-dir*
+ (setf *file-transfer-temporary-dir*
+ (format nil "~A_file-upload-tmp/" forgerie-core:*working-directory*))
+ (ensure-directories-exist *file-transfer-temporary-dir*))
+ (let
+ ((link-path
+ (pathname
+ (format nil "~A~A"
+ *file-transfer-temporary-dir*
+ (forgerie-core:file-name file)))))
+ (unwind-protect
+ (progn
+ (sb-posix:link (pathname (forgerie-core:file-location file)) link-path)
+ (post-request
+ (format nil "projects/~A/uploads" project-id)
+ `(("file" . ,link-path))))
+ (ignore-errors (delete-file link-path)))))))
+ (retrieve-mapping :file-uploaded (forgerie-core:file-id file))))
(defun format-labels-for-post (issue-labels)
(format nil "~{~A~^,~}"
(remove-if
(lambda (label)
(find label '("state:open" "state:resolved") :test #'string=))
issue-labels)))
(defvar *ticket-labels-map* nil)
(defvar *ticket-state-map* nil)
(defun create-ticket-action (gl-ticket vc-ticket action)
(let*
((action-type
(forgerie-core:ticket-action-type action))
(new-value
(forgerie-core:ticket-action-newvalue action))
(author-username
(forgerie-core:user-username (ensure-user-created (forgerie-core:ticket-action-author action))))
(action-date-str (to-iso-8601 (forgerie-core:ticket-action-date action)))
(ticket-map-id (getf gl-ticket :id))
(known-state (or (cdr (assoc ticket-map-id *ticket-state-map*)) (getf gl-ticket :state)))
(known-labels (or (cdr (assoc ticket-map-id *ticket-labels-map*)) (getf gl-ticket :labels)))
(changes-for-close
(lambda (&key (state "resolved"))
(let*
((state-label
(format nil "state:~A" state))
(new-labels
(cons
state-label
(remove-if
(lambda (label) (str:starts-with? "state:" label))
known-labels))))
(setf *ticket-labels-map* (acons ticket-map-id new-labels *ticket-labels-map*))
`(("labels" . ,(format-labels-for-post new-labels))
,@(when (string= known-state "opened")
(setf *ticket-state-map* (acons ticket-map-id "closed" *ticket-state-map*))
'(("state_event" . "close")))))))
(ticket-changes
(case action-type
(:open
(let*
((state-label
(format nil "state:~A" new-value))
(new-labels
(cons
state-label
(remove-if
(lambda (label) (str:starts-with? "state:" label))
known-labels))))
(setf *ticket-labels-map* (acons ticket-map-id new-labels *ticket-labels-map*))
`(("labels" . ,(format-labels-for-post new-labels))
,@(when (string= known-state "closed")
(setf *ticket-state-map* (acons ticket-map-id "opened" *ticket-state-map*))
'(("state_event" . "reopen"))))))
(:closed
(funcall changes-for-close :state new-value))
(:mergeinto
;; TODO: add note or ticket link for the ticket we've merged into
(funcall changes-for-close :state "duplicate"))
(:title
`(("title" . ,new-value)))
(:description
`(("description" . ,(process-note-text
(append new-value (list (ticket-suffix vc-ticket)))
(getf gl-ticket :project_id)))))
(:priority
(let*
((priority-label
(format nil "priority:~A" new-value))
(new-labels
(cons
priority-label
(remove-if
(lambda (label) (str:starts-with? "priority:" label))
known-labels))))
(setf *ticket-labels-map* (acons ticket-map-id new-labels *ticket-labels-map*))
`(("labels" . ,(format-labels-for-post new-labels)))))
(:reassign
(let
((assignee-id
(if new-value
(getf (retrieve-mapping :user (forgerie-core:user-username (ensure-user-created new-value))) :id))))
`(("assignee_ids" . ,(format nil "[~@[~A~]]" assignee-id)))))
(:subscribers)
(otherwise (error "Unknown ticket action ~A" action-type)))))
(when ticket-changes
(put-request
(format nil "projects/~A/issues/~A" (getf gl-ticket :project_id) (getf gl-ticket :iid))
`(("updated_at" . ,action-date-str)
,@ticket-changes)
:sudo author-username))))
(defun create-ticket (ticket vc-repositories)
(single-project-check
(let
((vc-repos (ticket-assignable-vc-repositories ticket vc-repositories)))
(if vc-repos (forgerie-core:vc-repository-name (car vc-repos)) (getf *default-project* :name)))
(when (project-for-ticket ticket vc-repositories)
(when-unmapped (:ticket-completed (forgerie-core:ticket-id ticket))
(let*
((project (project-for-ticket ticket vc-repositories))
(project-id (getf project :id))
(actions-and-notes
(stable-sort
(copy-list
(append
(forgerie-core:ticket-notes ticket)
(forgerie-core:ticket-actions ticket)))
#'<
:key (lambda (action-or-note)
(ctypecase action-or-note
(forgerie-core:note (forgerie-core:note-date action-or-note))
(forgerie-core:ticket-action (forgerie-core:ticket-action-date action-or-note))))))
(first-description-action
(find-if
(lambda (action-or-note)
(typecase action-or-note
(forgerie-core:ticket-action
(equalp (forgerie-core:ticket-action-type action-or-note) :description))))
actions-and-notes))
(orig-description
(if first-description-action
(forgerie-core:ticket-action-newvalue first-description-action)
(forgerie-core:ticket-description ticket)))
(first-title-action
(find-if
(lambda (action-or-note)
(typecase action-or-note
(forgerie-core:ticket-action
(equalp (forgerie-core:ticket-action-type action-or-note) :title))))
actions-and-notes))
(orig-title
(if first-title-action
(forgerie-core:ticket-action-newvalue first-title-action)
(forgerie-core:ticket-title ticket))))
(when-unmapped (:ticket (forgerie-core:ticket-id ticket))
(let
((gl-ticket
(post-request
(format nil "projects/~A/issues" project-id)
`(("iid" . ,(prin1-to-string (forgerie-core:ticket-id ticket)))
("title" . ,orig-title)
("labels" .
,(format-labels-for-post
(mapcar #'forgerie-core:project-name (forgerie-core:ticket-projects ticket))))
("confidential" . ,(if (forgerie-core:ticket-confidential ticket) "true" "false"))
("description" . ,(process-note-text (append orig-description (list (ticket-suffix ticket))) project-id))
("created_at" . ,(to-iso-8601 (forgerie-core:ticket-date ticket))))
:sudo (forgerie-core:user-username (ensure-user-created (forgerie-core:ticket-author ticket))))))
(when (/= (getf gl-ticket :iid) (forgerie-core:ticket-id ticket))
(forgerie-core:add-mapping-error
:ticket-iid-not-set
(forgerie-core:ticket-id ticket)
(format nil "Ticket iid ignored by gitlab for ~A (~A)" (forgerie-core:ticket-id ticket) (getf (getf gl-ticket :references) :full))))
(update-event-date "Issue" (getf gl-ticket :id) (forgerie-core:ticket-date ticket))
(mapc
(lambda (u)
(post-request
(format nil "projects/~A/issues/~A/subscribe" (getf gl-ticket :project_id) (getf gl-ticket :iid))
nil
:sudo (forgerie-core:user-username (ensure-user-created u))))
(forgerie-core:ticket-subscribers ticket))
(update-mapping (:ticket (forgerie-core:ticket-id ticket)) gl-ticket)))
(when
(and
*notes-mode*
(not (find-mapped-item :ticket-completed (forgerie-core:ticket-id ticket))))
(let
((gl-ticket (get-request (format nil "projects/~A/issues/~A" project-id (forgerie-core:ticket-id ticket)))))
(mapc
(lambda (action-or-note)
(typecase action-or-note
(forgerie-core:note
(create-note (getf gl-ticket :project_id) "issues" (getf gl-ticket :iid) action-or-note))
(forgerie-core:ticket-action
(create-ticket-action gl-ticket ticket action-or-note))
(t (error "Unknown type"))))
actions-and-notes)
(update-mapping (:ticket-completed (forgerie-core:ticket-id ticket))))))))))
(defun create-ticket-links (ticket vc-repositories)
(when
(find-mapped-item :ticket (forgerie-core:ticket-id ticket))
(when-unmapped (:ticket-links (forgerie-core:ticket-id ticket))
(single-project-check
(let
((vc-repos (ticket-assignable-vc-repositories ticket vc-repositories)))
(if vc-repos (forgerie-core:vc-repository-name (car vc-repos)) (getf *default-project* :name)))
(let
((gl-ticket (retrieve-mapping :ticket (forgerie-core:ticket-id ticket))))
(mapcar
(lambda (linked-ticket)
(let
((gl-linked-ticket (ignore-errors (retrieve-mapping :ticket (forgerie-core:ticket-id linked-ticket)))))
(if (not gl-linked-ticket)
(forgerie-core:add-mapping-error
:linked-ticket-not-found
(forgerie-core:ticket-id linked-ticket)
(format nil "Link was between ~A and ~A" (forgerie-core:ticket-id ticket) (forgerie-core:ticket-id linked-ticket)))
(post-request
(format nil "projects/~A/issues/~A/links" (getf gl-ticket :project_id) (getf gl-ticket :iid))
`(("target_project_id" . ,(princ-to-string (getf gl-linked-ticket :project_id)))
("target_issue_iid" . ,(princ-to-string (getf gl-linked-ticket :iid))))))))
(forgerie-core:ticket-linked-tickets ticket)))
(update-mapping (:ticket-links (forgerie-core:ticket-id ticket)))))))
(defun ensure-user-created (user)
(when (and *limit-to-active-users* (validate-user user)) (create-user user))
user)
(defun email-verified-to-string (email)
(if (forgerie-core:email-is-verified email) "true" "false"))
(defun create-user (user)
(when-unmapped-with-update (:user (forgerie-core:user-username user))
(let
((user-on-gitlab
(first (get-request "users"
:parameters
`(("username" . ,(forgerie-core:user-username user)))))))
(if user-on-gitlab
;; user exists
(progn
(unless (getf user-on-gitlab :is_admin)
(set-gitlab-admin-status (getf user-on-gitlab :id) t))
user-on-gitlab)
;; create user, handling avatar + emails
(let*
((avatar (forgerie-core:user-avatar user))
(avatar
(when avatar
(if (> (* 1024 200) (forgerie-core:file-size avatar))
avatar
(progn
(forgerie-core:add-mapping-error
:user-avatar-too-big
(forgerie-core:user-username user)
(format nil "User ~A's avatar is ~A, which is bigger than the allowed 200k" (forgerie-core:user-username user) (forgerie-core:file-size avatar)))))))
(avatar-filename
(when avatar
(if
(find-if
(lambda (ext) (cl-ppcre:scan (format nil "~A$" ext) (forgerie-core:file-name avatar)))
(list "png" "jpg" "jpeg" "gif" "bmp" "tiff" "ico" "webp"))
(forgerie-core:file-name avatar)
(format nil "~A.~A" (forgerie-core:file-name avatar)
(cond
((cl-ppcre:scan "^image/" (forgerie-core:file-mimetype avatar)) (subseq (forgerie-core:file-mimetype avatar) 6))
(t (error (format nil "Don't know profile mimetype ~A" (forgerie-core:file-mimetype avatar)))))))))
(avatar-filepath-with-mimetype
(when avatar-filename
(format nil "~A.~A"
(forgerie-core:file-location avatar)
(subseq (forgerie-core:file-mimetype avatar) 6))))
(gl-user
(progn
(when avatar-filepath-with-mimetype
(uiop:copy-file (forgerie-core:file-location avatar) avatar-filepath-with-mimetype))
;; using the new make-request implementation (dexador) does not work
;; so use the previous slower implementation which works
(post-request
"users"
`(("name" . ,(forgerie-core:user-name user))
("email" . ,(forgerie-core:email-address (forgerie-core:user-primary-email user)))
; Everyone must be an admin to make some of the other import things work correctly
; and then admin must be removed after
("admin" . "true")
("reset_password" . "true")
("skip_confirmation" . ,(email-verified-to-string (forgerie-core:user-primary-email user)))
("username" . ,(forgerie-core:user-username user))
,@(when avatar-filepath-with-mimetype
`(("avatar" . ,(pathname avatar-filepath-with-mimetype)))))))))
(mapcar
(lambda (email)
(post-request (format nil "/users/~A/emails" (getf gl-user :id))
`(("email" . ,(forgerie-core:email-address email))
("skip_confirmation" . ,(email-verified-to-string email)))))
(remove-if #'forgerie-core:email-is-primary (forgerie-core:user-emails user)))
gl-user)))))
(defun set-gitlab-admin-status (gl-user-id should-be-admin)
(put-request
(format nil "/users/~A" gl-user-id)
`(("admin" . ,(if should-be-admin "true" "false")))))
(defun update-user-admin-status (user &optional override)
(let
((should-be-admin (or override (forgerie-core:user-admin user)))
(forgerie-username (forgerie-core:user-username user)))
(when forgerie-core:*debug* (format t "Requesting is_admin:~A for user ~A~%" should-be-admin forgerie-username))
(when
(find-mapped-item :user forgerie-username)
(let
((gl-user (retrieve-mapping :user forgerie-username)))
(set-gitlab-admin-status (getf gl-user :id) should-be-admin)))))
(defun add-users-to-projects (vc-repositories users)
(let
((users-to-gl-users
(mapcar
(lambda (user)
(list
(forgerie-core:user-username user)
(retrieve-mapping :user (forgerie-core:user-username user))))
(remove-if-not (lambda (user) (find-mapped-item :user (forgerie-core:user-username user))) users))))
(mapcar
(lambda (vc-repository)
(when-unmapped (:members-added-to-project (forgerie-core:vc-repository-slug vc-repository))
(let
((gl-project (find-gitlab-project vc-repository)))
(mapcar
(lambda (user)
(let
((gl-user (cadr (find (forgerie-core:user-username user) users-to-gl-users :key #'car :test #'string=))))
(when gl-user
(handler-case
(post-request
(format nil "/projects/~A/members" (getf gl-project :id))
`(("user_id" . ,(prin1-to-string (getf gl-user :id)))
("access_level" . "30")))
(http-error (e) (format t "Ran into error on members ~S~%" e))))))
users))
(update-mapping (:members-added-to-project (forgerie-core:vc-repository-slug vc-repository)))))
vc-repositories)))
(defun create-local-checkout (project)
(when (not (probe-file (format nil "~A~A" *working-directory* (getf project :path))))
(ensure-directories-exist (format nil "~A~A/" *working-directory* (getf project :path)))
(git-cmd project "clone" "-o" "gitlab" (getf project :ssh_url_to_repo) ".")))
(defun create-change-comments (gl-mr change)
(let*
((versions (get-request (format nil "/projects/~A/merge_requests/~A/versions" (getf gl-mr :project_id) (getf gl-mr :iid))))
; This may not work! We may have to figure out how to correlate version with this commit
(version-for-change (car versions)))
(mapcar
(lambda (comment)
(let
((note-text (process-note-text (forgerie-core:merge-request-change-comment-text comment) (getf gl-mr :project_id))))
(when
(and note-text (not (zerop (length note-text))))
(handler-case
(let
((discussion
(post-request
(format nil "/projects/~A/merge_requests/~A/discussions" (getf gl-mr :project_id) (getf gl-mr :iid))
`(("position[position_type]" . "text")
("position[base_sha]" . ,(getf version-for-change :base_commit_sha))
("position[head_sha]" . ,(getf version-for-change :head_commit_sha))
("position[start_sha]" . ,(getf version-for-change :start_commit_sha))
;("position[line_range][start][line_code]" . "40606d8fa72800ddf68b5f2cf2b0b30e1d2de8e2_224_131")
;("position[line_range][start][type]" . "new")
;("position[line_range][start][new_line]" . "131")
;("position[line_range][end][line_code]" . "40606d8fa72800ddf68b5f2cf2b0b30e1d2de8e2_224_134")
;("position[line_range][end][type]" . "new")
;("position[line_range][end][new_line]" . "134")
,@(when (forgerie-core:merge-request-change-comment-new-line comment)
(list (cons "position[new_line]" (princ-to-string (cadr (forgerie-core:merge-request-change-comment-new-line comment))))))
,@(when (forgerie-core:merge-request-change-comment-old-line comment)
(list (cons "position[old_line]" (princ-to-string (cadr (forgerie-core:merge-request-change-comment-new-line comment))))))
("position[old_path]" . ,(forgerie-core:merge-request-change-comment-file comment))
("position[new_path]" . ,(forgerie-core:merge-request-change-comment-file comment))
("body" . ,note-text)
("created_at" . ,(to-iso-8601 (forgerie-core:merge-request-change-comment-date comment))))
:sudo (forgerie-core:user-username (ensure-user-created (forgerie-core:merge-request-change-comment-author comment))))))
(when (first (getf discussion :notes))
(update-event-date
"DiffNote"
(getf (first (getf discussion :notes)) :id) ;; get the id of the first note in the discussion, created by the previous post-request
(forgerie-core:merge-request-change-comment-date comment)))
(mapcar
(lambda (comment)
(let
((note-text (process-note-text (forgerie-core:merge-request-change-comment-text comment) (getf gl-mr :project_id))))
(when
(and note-text (not (zerop (length note-text))))
(let
((diff-note
(post-request
(format nil "/projects/~A/merge_requests/~A/discussions/~A/notes" (getf gl-mr :project_id) (getf gl-mr :iid) (getf discussion :id))
`(("body" . ,note-text)
("created_at" . ,(to-iso-8601 (forgerie-core:merge-request-change-comment-date comment))))
:sudo (forgerie-core:user-username (ensure-user-created (forgerie-core:merge-request-change-comment-author comment))))))
(update-event-date
"DiffNote"
(getf diff-note :id)
(forgerie-core:merge-request-change-comment-date comment))))))
(forgerie-core:merge-request-change-comment-replies comment)))
(http-error (e)
(cond
((= 400 (http-error-code e))
(format t "400 error in create-change-comments: ~A~%" (http-error-resp e)))
((= 500 (http-error-code e))
(format t "500 error in create-change-comments: ~A~%" (http-error-resp e)))
(t (error e))))))))
(forgerie-core:merge-request-change-comments change))))
(defun record-mr-action (gl-mr forgerie-mr action)
(flet ((update-last-mr-event ()
(update-event-date "MergeRequest"
(getf gl-mr :id)
(forgerie-core:merge-request-action-date action)
:extra-filter ".where(:action => \"closed\")"))
(update-last-mr-rse ()
(rails-commands-with-recovery
(list
(format nil "action_time = Time.parse(\"~A\")" (to-iso-8601 (forgerie-core:merge-request-action-date action)))
(format nil "mr = MergeRequest.find(~A)" (getf gl-mr :id))
"rse = mr.resource_state_events[-1]"
"rse.created_at = action_time"
"rse.save")))
(update-mr-updated-at ()
(rails-commands-with-recovery
(list
(format nil "action_time = Time.parse(\"~A\")" (to-iso-8601 (forgerie-core:merge-request-action-date action)))
(format nil "mr = MergeRequest.find(~A)" (getf gl-mr :id))
"mr.updated_at = action_time"
"mr.save"
"mr.metrics.updated_at = action_time"
"mr.metrics.latest_closed_at = action_time"
"mr.metrics.save"))))
(let* ((action-type (forgerie-core:merge-request-action-type action))
(action-text (case action-type (:abandon "abandoned") (:close "merged"))))
(case action-type
((:abandon :close)
;; Write a synthetic note explaining why the MR is closed
(create-note (getf gl-mr :project_id) "merge_requests" (getf gl-mr :iid)
(forgerie-core:make-note
:id (format nil "D~A-synthetic-~A-at-~A"
(forgerie-core:merge-request-id forgerie-mr)
action-text
(forgerie-core:merge-request-action-date action))
:author (forgerie-core:merge-request-action-author action)
:date (forgerie-core:merge-request-action-date action)
:text (list (format nil "Merge request was ~A" action-text))))
;; Close the MR
(put-request
(format nil "/projects/~A/merge_requests/~A" (getf gl-mr :project_id) (getf gl-mr :iid))
'(("state_event" . "close"))
:sudo (forgerie-core:user-username (ensure-user-created (forgerie-core:merge-request-action-author action))))
(update-last-mr-event)
(update-last-mr-rse)
(update-mr-updated-at))
))))
(defun create-merge-request (mr)
(single-project-check
(forgerie-core:vc-repository-name (forgerie-core:merge-request-vc-repository mr))
(when-unmapped (:merge-request-completed (forgerie-core:merge-request-id mr))
(let*
((vc-repo (forgerie-core:merge-request-vc-repository mr))
(project (find-gitlab-project vc-repo)))
(when-unmapped (:merge-request (forgerie-core:merge-request-id mr))
(when (not project)
(error "Could not find project with slug: ~A" (forgerie-core:vc-repository-slug vc-repo)))
(create-local-checkout project)
; We do this first, because if this errors, we want to bomb out first without doing the work
; to create all the branches and whatnot. The other option would be to add a mapping for
; the git work we need to do, but this seemed more elegant.
(process-note-text (forgerie-core:merge-request-description mr) (getf project :id))
(when
(not
(zerop
(git-cmd-code project "show-ref" "--verify" "--quiet"
(format nil "refs/heads/~A" (forgerie-core:branch-name (forgerie-core:merge-request-source-branch mr))))))
(git-cmd project "branch"
(forgerie-core:branch-name (forgerie-core:merge-request-source-branch mr))
(forgerie-core:commit-sha (forgerie-core:branch-commit (forgerie-core:merge-request-source-branch mr)))))
(when
(not
(zerop
(git-cmd-code project "show-ref" "--verify" "--quiet"
(format nil "refs/heads/~A" (forgerie-core:branch-name (forgerie-core:merge-request-target-branch mr))))))
(git-cmd project "branch"
(forgerie-core:branch-name (forgerie-core:merge-request-target-branch mr))
(forgerie-core:commit-sha (forgerie-core:branch-commit (forgerie-core:merge-request-source-branch mr)))))
(git-cmd project "checkout"
(forgerie-core:branch-name (forgerie-core:merge-request-source-branch mr)))
(mapcar
(lambda (change)
(let
((commit (forgerie-core:merge-request-change-change change)))
(typecase commit
(forgerie-core:commit (git-cmd project "merge" (forgerie-core:commit-sha commit)))
(forgerie-core:patch
(let
((patch-file (format nil "~A/working.patch" *working-directory*)))
(with-open-file (str patch-file :direction :output :if-exists :supersede :if-does-not-exist :create)
(princ (forgerie-core:patch-diff commit) str))
(git-cmd project "am" patch-file)
(delete-file patch-file))))))
(forgerie-core:merge-request-changes mr))
(git-cmd project "push" "gitlab" (forgerie-core:branch-name (forgerie-core:merge-request-source-branch mr)))
(git-cmd project "push" "gitlab" (forgerie-core:branch-name (forgerie-core:merge-request-target-branch mr)))
(update-mapping (:merge-request (forgerie-core:merge-request-id mr))
(post-request
(format nil "projects/~A/merge_requests" (getf project :id))
`(("source_branch" . ,(forgerie-core:branch-name (forgerie-core:merge-request-source-branch mr)))
("target_branch" . ,(forgerie-core:branch-name (forgerie-core:merge-request-target-branch mr)))
("description" . ,(process-note-text (append (forgerie-core:merge-request-description mr) (list (merge-request-suffix mr))) (getf project :id)))
("title" . ,(forgerie-core:merge-request-title mr)))
:sudo (forgerie-core:user-username (ensure-user-created (forgerie-core:merge-request-author mr))))))
(when *notes-mode*
(let
((gl-mr (retrieve-mapping :merge-request (forgerie-core:merge-request-id mr))))
(update-event-date "MergeRequest" (getf gl-mr :id) (forgerie-core:merge-request-date mr))
(rails-commands-with-recovery
(list
(format nil "creation_time = Time.parse(\"~A\")" (to-iso-8601 (forgerie-core:merge-request-date mr)))
(format nil "mr = MergeRequest.find(~A)" (getf gl-mr :id))
"mr.created_at = creation_time"
"mr.save"
"mr.metrics.created_at = creation_time"
"mr.metrics.save"))
(mapcar
(lambda (note) (create-note (getf gl-mr :project_id) "merge_requests" (getf gl-mr :iid) note))
(forgerie-core:merge-request-notes mr))
(mapcar
(lambda (change)
(create-change-comments gl-mr change))
(forgerie-core:merge-request-changes mr))
(mapcar
(lambda (action)
(record-mr-action gl-mr mr action))
(forgerie-core:merge-request-actions mr))
(when (eql :closed (forgerie-core:merge-request-type mr))
(git-cmd project "push" "gitlab" "--delete" (forgerie-core:branch-name (forgerie-core:merge-request-source-branch mr)))
(git-cmd project "push" "gitlab" "--delete" (forgerie-core:branch-name (forgerie-core:merge-request-target-branch mr))))
(update-mapping (:merge-request-completed (forgerie-core:merge-request-id mr)))))))))
(defun create-snippet (snippet)
(single-project-check (getf *default-project* :name)
(when (default-project)
(when-unmapped (:snippet-completed (forgerie-core:snippet-id snippet))
(when
(/= 1 (length (forgerie-core:snippet-files snippet)))
(error "Can only export snippets with exactly one file for now"))
(let
((default-project (default-project))
(file (first (forgerie-core:snippet-files snippet))))
(if
(zerop (forgerie-core:file-size file))
(forgerie-core:add-mapping-error
:gitlab-snippet-empty
(forgerie-core:snippet-id snippet)
(format nil "Skipping snippet ~A because empty content" (forgerie-core:snippet-id snippet)))
(progn
(when-unmapped (:snippet (forgerie-core:snippet-id snippet))
(handler-case
(update-mapping (:snippet (forgerie-core:snippet-id snippet))
(let
((content
(with-open-file (str (forgerie-core:file-location file) :element-type 'unsigned-byte)
(let ((seq (make-sequence 'vector (file-length str)))) (read-sequence seq str) (trivial-utf-8:utf-8-bytes-to-string seq)))))
(post-request
(format nil "/projects/~A/snippets" (getf default-project :id))
; This is deprecated, but it's an easier interface for now. Someday we may have
; an importer that has more than one file, or gitlab may fully remove this, and
; then this code will need to be updated
;
; See https://docs.gitlab.com/ee/api/snippets.html#create-new-snippet
`(("title" . ,(or (forgerie-core:snippet-title snippet) "Forgerie Generated Title"))
("content" . ,content)
("visibility" . ,(if (forgerie-core:snippet-private snippet) "private" "public"))
("file_name" . ,(forgerie-core:file-name file))))))
(error (e)
(format t "Failed to create snippet with title ~A~%, due to error ~A~%" (forgerie-core:snippet-title snippet) e)
(forgerie-core:add-mapping-error
:gitlab-snippet-error
(forgerie-core:snippet-id snippet)
(format nil "Failed to create snippet with title ~A, due to error ~A" (forgerie-core:snippet-title snippet) e)))))
(when *notes-mode*
(let
((gl-snippet (retrieve-mapping :snippet (forgerie-core:snippet-id snippet))))
(list
gl-snippet
(mapcar
(lambda (note) (create-note (getf default-project :id) "snippets" (getf gl-snippet :id) note))
(forgerie-core:snippet-notes snippet)))
(rails-commands-with-recovery
(list
(format nil "s = Snippet.find(~A)" (getf gl-snippet :id))
(format nil "u = User.find_by_username(\"~A\")" (forgerie-core:user-username (ensure-user-created (forgerie-core:snippet-author snippet))))
(format nil "s.created_at = Time.parse(\"~A\")" (to-iso-8601 (forgerie-core:snippet-date snippet)))
"s.author = u"
"s.save"))
(update-mapping (:snippet-completed (forgerie-core:snippet-id snippet)) gl-snippet))))))))))