From 78b41236ab3705041c2509ed09910eed1384027f Mon Sep 17 00:00:00 2001
From: Puck Meerburg <puck@puckipedia.com>
Date: Mon, 23 Jun 2025 12:22:20 +0000
Subject: [PATCH] (zilch magic): handle FODs with CA dependencies properly

Whilst not CA themselves, they can safely depend on CA inputs. Thus,
they need rewrites.
---
 core/src/magic.sld | 42 ++++++++++++++++++++++++++++++++----------
 1 file changed, 32 insertions(+), 10 deletions(-)

diff --git a/core/src/magic.sld b/core/src/magic.sld
index e5de45b..6592a28 100644
--- a/core/src/magic.sld
+++ b/core/src/magic.sld
@@ -265,6 +265,12 @@
    (define (drv-is-ca drv)
      (define is-ca #f)
      (for-each (lambda (out) (when (eq? (derivation-output-hash (cdr out)) 'floating) (set! is-ca #t))) (derivation-outputs drv))
+     (when (drv-is-fod drv)
+      (let loop ((drvs (derivation-input-drvs drv)))
+       (cond
+        ((null? drvs) #f)
+        ((drv-is-ca (caar drvs)) (set! is-ca #t))
+        (else (loop (cdr drvs))))))
      is-ca)
 
    (define (rewrite-string str with-rewrites)
@@ -414,14 +420,28 @@
          (define new-args (map (lambda (v) (rewrite-string-or-bytevector v rewrites)) (derivation-args ca-drv)))
          (define new-env (map (lambda (kv) (cons (car kv) (rewrite-string-or-bytevector (cdr kv) rewrites))) (derivation-env ca-drv)))
          (define ia-drv
-          (make-input-addressed-derivation
+          (if (drv-is-fod ca-drv)
+           (let ((output (cdar (derivation-outputs ca-drv))))
+            (make-fixed-output-derivation
+             (derivation-name ca-drv)
+             (derivation-system ca-drv)
+             (list-sort
+              (lambda (l r) (string<? (derivation-path (car l)) (derivation-path (car r))))
+              new-drvs)
+             (list-sort string<? new-srcs)
+             (cons new-builder new-args)
+             new-env
+             (derivation-output-algo output)
+             (derivation-output-hash output)
+             (derivation-output-recursive output)))
+           (make-input-addressed-derivation
             (derivation-name ca-drv)
             (derivation-system ca-drv)
             (list-sort
-              (lambda (l r) (string<? (derivation-path (car l)) (derivation-path (car r))))
-              new-drvs)
+             (lambda (l r) (string<? (derivation-path (car l)) (derivation-path (car r))))
+             new-drvs)
             (list-sort string<? new-srcs)
-            (cons new-builder new-args) new-env (map car (derivation-outputs ca-drv))))
+            (cons new-builder new-args) new-env (map car (derivation-outputs ca-drv)))))
          (set-pending-item-ia-drv! item ia-drv)
 
          ; Build all the paths.
@@ -443,12 +463,14 @@
            (lambda ()
             (daemon-wop-build-paths conn (list->vector (map (lambda (v) (string-append (derivation-path ia-drv) "!" v)) outputs)))))
           (daemon-wop-build-paths conn (list->vector (map (lambda (v) (string-append (derivation-path ia-drv) "!" v)) outputs))))
-         (set-pending-item-resolved-paths! item
-          (map (lambda (o)
-                 (define-values (name hash nar-size ca-store-path)
-                   (store-path-to-fod conn (derivation-output-path (cdr (assoc o (derivation-outputs ia-drv) string=?)))))
-                 (cons o ca-store-path))
-           outputs))
+         (if (drv-is-fod ia-drv)
+          (set-pending-item-resolved-paths! item (list (cons "out" (derivation-output-path (cdar (derivation-outputs ia-drv))))))
+          (set-pending-item-resolved-paths! item
+           (map (lambda (o)
+                  (define-values (name hash nar-size ca-store-path)
+                    (store-path-to-fod conn (derivation-output-path (cdr (assoc o (derivation-outputs ia-drv) string=?)))))
+                  (cons o ca-store-path))
+            outputs)))
 
          ; Notify our dependencies that we're done.
          (mutex-lock! pending-count-mutex)