seihou-core 0.13.0.0 → 0.14.0.0

raw patch · 22 files changed

+806/−73 lines, 22 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• seihou-core.cabal +2/−1
• src/Seihou/Composition/Recipe.hs +182/−16
• src/Seihou/Composition/RecipeChain.hs +86/−0
• src/Seihou/Composition/Resolve.hs +23/−2
• src/Seihou/Core/Application.hs +2/−1
• src/Seihou/Core/Recipe.hs +62/−5
• src/Seihou/Core/Types.hs +43/−3
• src/Seihou/Core/Variable.hs +5/−0
• src/Seihou/Dhall/Eval.hs +28/−3
• src/Seihou/Manifest/Types.hs +67/−16
• src/Seihou/Manifest/Upgrade.hs +17/−1
• test/Seihou/Composition/RecipeSpec.hs +147/−7
• test/Seihou/Core/ApplicationSpec.hs +2/−1
• test/Seihou/Core/RecipeSpec.hs +67/−7
• test/Seihou/Core/SeedSpec.hs +1/−0
• test/Seihou/Dhall/EvalSpec.hs +16/−0
• test/Seihou/Engine/CheckoutSpec.hs +1/−1
• test/Seihou/Engine/RemoveSpec.hs +1/−1
• test/Seihou/Engine/SeedTransactionSpec.hs +1/−1
• test/Seihou/Interaction/PromptSpec.hs +15/−1
• test/Seihou/Manifest/TypesSpec.hs +28/−6
• test/Seihou/Manifest/UpgradeSpec.hs +10/−0

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-core-version: 0.13.0.0+version: 0.14.0.0 synopsis: Core library for Seihou project scaffolding description:   Core library for Seihou, a composable project scaffolding system.@@ -38,6 +38,7 @@     Seihou.Composition.Instance     Seihou.Composition.Plan     Seihou.Composition.Recipe+    Seihou.Composition.RecipeChain     Seihou.Composition.Resolve     Seihou.Core.AgentPrompt     Seihou.Core.Application

@@ -1,32 +1,198 @@ module Seihou.Composition.Recipe   ( expandRecipe,+    ExpandedRecipe (..),+    ResolvedRecipeNode (..),+    ResolvedRecipeMember (..),+    RecipeLiteral (..),+    mergeRecipeChain,+    recipeLiteralSources,   ) where -import Control.Lens ((^.))+import Control.Lens ((&), (.~), (^.))+import Control.Monad (foldM, unless, when) import Data.Generics.Labels () import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map+import Data.Maybe (isJust) import Data.Text (Text)-import Seihou.Core.Recipe (validateRecipe)+import Data.Text qualified as T+import GHC.Generics (Generic)+import Seihou.Core.ArtifactIdentity (sameArtifactIdentity)+import Seihou.Core.Recipe (validateRecipe, validateRecipeVersion) import Seihou.Core.Types -type ExpandedRecipe = (ModuleName, [ModuleName], Map VarName Text, [VarDecl], [Prompt], [Dependency])+-- | Context belongs to the declaring recipe, even after member deduplication.+data ResolvedRecipeMember = ResolvedRecipeMember+  { dependency :: !Dependency,+    declaringRecipe :: !RecipeName,+    declaringOrigin :: !ArtifactOrigin,+    declaringDirectory :: !FilePath,+    memberOrigin :: !ArtifactOrigin+  }+  deriving stock (Eq, Show, Generic) --- | Expand a 'Recipe' into the inputs that the existing composition pipeline--- expects: a primary module name, additional module names, variable overrides,--- recipe-level variable declarations, prompts, and intact source requirements.------ The first module in the recipe's list becomes the primary module (used for--- config namespace derivation). All remaining modules become additional modules.--- Variable overrides are collected from each module entry's @vars@ bindings.-expandRecipe :: Recipe -> Either [Text] ExpandedRecipe+data ResolvedRecipeNode = ResolvedRecipeNode+  { definition :: !Recipe,+    origin :: !ArtifactOrigin,+    directory :: !FilePath,+    members :: ![ResolvedRecipeMember]+  }+  deriving stock (Eq, Show, Generic)++data RecipeLiteral = RecipeLiteral+  { value :: !Text,+    recipe :: !RecipeName,+    origin :: !ArtifactOrigin,+    member :: !ModuleName+  }+  deriving stock (Eq, Show, Generic)++data ExpandedRecipe = ExpandedRecipe+  { primary :: !ModuleName,+    members :: ![ResolvedRecipeMember],+    literals :: !(Map VarName RecipeLiteral),+    declarations :: ![VarDecl],+    prompts :: ![Prompt],+    chain :: ![ResolvedRecipeNode]+  }+  deriving stock (Eq, Show, Generic)++-- | Compatibility API for flat recipes. Never silently discard an extension.+expandRecipe :: Recipe -> Either [Text] (ModuleName, [ModuleName], Map VarName Text, [VarDecl], [Prompt], [Dependency]) expandRecipe recipe = do   validated <- validateRecipe recipe+  when (isJust (validated ^. #extends)) $+    Left ["Recipe extends a base; use origin-aware recipe-chain expansion"]   case validated ^. #modules of     [] -> Left ["recipe must list at least one module"]-    primary : additional ->-      let primaryName = (primary ^. #module_)-          additionalNames = map (^. #module_) additional-          overrides = Map.unions (map (^. #vars) (validated ^. #modules))-       in Right (primaryName, additionalNames, overrides, validated ^. #vars, validated ^. #prompts, validated ^. #modules)+    first : rest ->+      Right+        ( first ^. #module_,+          map (^. #module_) rest,+          Map.unions (map (^. #vars) (validated ^. #modules)),+          validated ^. #vars,+          validated ^. #prompts,+          validated ^. #modules+        )++-- | Merge an already resolved oldest-first chain. IO lookup and source proof+-- happen before this function; no member's binding becomes a graph edge.+mergeRecipeChain :: [ResolvedRecipeNode] -> Either [Text] ExpandedRecipe+mergeRecipeChain [] = Left ["Recipe chain is empty"]+mergeRecipeChain nodes@(oldest : _) = do+  mapM_ (validateRecipe . (^. #definition)) nodes+  when (isJust (oldest ^. #definition . #extends)) (Left ["Unresolved oldest recipe base"])+  checkLinks nodes+  (mergedMembers, bindings, decls, questions) <- foldM layer ([], Map.empty, [], []) nodes+  case mergedMembers of+    [] -> Left ["Expanded recipe must list at least one module"]+    first : _ -> do+      -- Reuse descriptor checks on the complete declaration/prompt scope.+      let lastRecipe = foldl (\_ n -> n ^. #definition) (oldest ^. #definition) nodes+          final =+            lastRecipe+              & #extends .~ Nothing+              & #moduleOverrides .~ []+              & #promptOverrides .~ []+              & #modules .~ map (^. #dependency) mergedMembers+              & #vars .~ decls+              & #prompts .~ questions+      _ <- validateRecipe final+      pure (ExpandedRecipe (first ^. #dependency . #module_) mergedMembers bindings decls questions nodes)+  where+    extended = length nodes > 1+    checkLinks (parent : child : rest) = do+      case child ^. #definition . #extends of+        Just ref | ref ^. #recipe == parent ^. #definition . #name -> validateRecipeVersion ref (parent ^. #definition)+        _ -> Left ["Recipe chain does not match its declared base"]+      checkLinks (child : rest)+    checkLinks [_] = Right ()+    checkLinks [] = Right ()++    layer (inherited, bindings, decls, questions) node = do+      let descriptor = node ^. #definition+          label = descriptor ^. #name . #unRecipeName+          failHere :: Text -> Either [Text] a+          failHere msg = Left ["Recipe '" <> label <> "': " <> msg]+      unless (map (^. #dependency) (node ^. #members) == descriptor ^. #modules) $+        failHere "resolved member context does not match descriptor"+      unless (not extended || unique (map (^. #var) questions)) $+        failHere "inherited prompts have ambiguous duplicate targets"+      changed <- foldM (overrideMember failHere) inherited (descriptor ^. #moduleOverrides)+      combined <- foldM (addMember failHere) changed (node ^. #members)+      let entries =+            [(dep ^. #module_, dep ^. #vars) | dep <- descriptor ^. #modules]+              <> [(o ^. #module_, o ^. #vars) | o <- descriptor ^. #moduleOverrides]+      delta <- foldM (addLiterals failHere node) Map.empty entries+      mergedDecls <- foldM (addDeclaration failHere) decls (descriptor ^. #vars)+      replaced <- foldM (overridePrompt failHere) questions (descriptor ^. #promptOverrides)+      mergedPrompts <-+        if extended+          then foldM (addPrompt failHere) replaced (descriptor ^. #prompts)+          else Right (descriptor ^. #prompts)+      pure (combined, Map.union delta bindings, mergedDecls, mergedPrompts)++    overrideMember failHere inherited override =+      case filter (\m -> m ^. #dependency . #module_ == override ^. #module_) inherited of+        [_] ->+          Right+            [ if m ^. #dependency . #module_ == override ^. #module_+                then m & #dependency . #vars .~ Map.union (override ^. #vars) (m ^. #dependency . #vars)+                else m+            | m <- inherited+            ]+        _ -> failHere "moduleOverrides must name exactly one inherited member"++    addMember failHere acc member = case filter (\m -> m ^. #dependency . #module_ == member ^. #dependency . #module_) acc of+      [] -> Right (acc <> [member])+      [old]+        | not (sameArtifactIdentity (old ^. #memberOrigin) (member ^. #memberOrigin)) -> failHere ("member '" <> member ^. #dependency . #module_ . #unModuleName <> "' requires different origins: " <> originLabel (old ^. #memberOrigin) <> " versus " <> originLabel (member ^. #memberOrigin))+        | old ^. #dependency . #vars /= member ^. #dependency . #vars -> failHere ("repeated member '" <> member ^. #dependency . #module_ . #unModuleName <> "' bindings conflict; use moduleOverrides")+        | otherwise -> Right acc+      _ -> failHere "ambiguous member identity"++    addLiterals failHere node acc (member, values) = foldM add acc (Map.toList values)+      where+        add current (name, value) = case Map.lookup name current of+          Just old | extended && old ^. #value /= value -> failHere ("unequal literal '" <> name ^. #unVarName <> "' in members '" <> old ^. #member . #unModuleName <> "' and '" <> member ^. #unModuleName <> "' (modules/moduleOverrides)")+          Just _ -> Right current+          Nothing -> Right (Map.insert name (RecipeLiteral value (node ^. #definition . #name) (node ^. #origin) member) current)++    addDeclaration failHere acc child = case filter (\d -> d ^. #name == child ^. #name) acc of+      [] -> Right (acc <> [child])+      [parent]+        | parent ^. #type_ /= child ^. #type_ || parent ^. #required /= child ^. #required || parent ^. #validation /= child ^. #validation ->+            failHere ("inherited variable '" <> child ^. #name . #unVarName <> "' type, requiredness or validation conflicts")+        | otherwise ->+            Right+              [ if d ^. #name == child ^. #name+                  then+                    child+                      & #default_ .~ nearest (child ^. #default_) (parent ^. #default_)+                      & #description .~ nearest (child ^. #description) (parent ^. #description)+                  else d+              | d <- acc+              ]+      _ -> failHere "ambiguous variable declaration"++    overridePrompt failHere acc child = case filter (\p -> p ^. #var == child ^. #var) acc of+      [_] -> Right [if p ^. #var == child ^. #var then child else p | p <- acc]+      _ -> failHere "promptOverrides must name exactly one inherited prompt"+    addPrompt failHere acc child = case filter (\p -> p ^. #var == child ^. #var) acc of+      [] -> Right (acc <> [child])+      [old] | old == child -> Right acc+      _ -> failHere "repeated prompt differs; use promptOverrides"+    nearest (Just x) _ = Just x+    nearest Nothing old = old+    unique [] = True+    unique (x : xs) = x `notElem` xs && unique xs++-- | Preserve source attribution when resolving declared and undeclared literals.+recipeLiteralSources :: ExpandedRecipe -> Map VarName (Text, VarSource)+recipeLiteralSources expanded = Map.map (\literal -> (literal ^. #value, FromRecipeBindingAt (literal ^. #recipe) (literal ^. #origin))) (expanded ^. #literals)++originLabel :: ArtifactOrigin -> Text+originLabel (RemoteOrigin url name _) = url <> "#" <> name+originLabel (ProjectOrigin path) = T.pack path+originLabel (LocalOrigin name) = name <> " (unverified local origin)"

@@ -0,0 +1,86 @@+-- | Offline discovery of a recipe chain and its member origins. Acquisition+-- belongs to install/update; this loader never fetches or changes the cache.+module Seihou.Composition.RecipeChain (loadRecipeChain, recordRecipeChain) where++import Control.Lens ((^.))+import Control.Monad (forM, unless, when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Except (ExceptT (..), runExceptT)+import Data.Generics.Labels ()+import Data.Text qualified as T+import Seihou.Composition.Recipe+import Seihou.Composition.Resolve (verifyDependencySources)+import Seihou.Core.ArtifactIdentity (normalizeOriginUrl, sameArtifactIdentity)+import Seihou.Core.ArtifactOriginDetect (detectArtifactOrigin, readOriginInfo)+import Seihou.Core.Module (discoverModule, discoverRunnable)+import Seihou.Core.Recipe (validateRecipe, validateRecipeVersion)+import Seihou.Core.Types+import Seihou.Dhall.Eval (normalizeDhallFile)+import Seihou.Manifest.Hash (hashContent)+import System.FilePath ((</>))++loadRecipeChain :: FilePath -> [FilePath] -> Recipe -> FilePath -> IO (Either ModuleLoadError ExpandedRecipe)+loadRecipeChain projectRoot paths target targetDir = do+  result <- runExceptT $ do+    nodes <- visit [] target targetDir+    ExceptT $ pure $ either (Left . ValidationError targetName) Right (mergeRecipeChain nodes)+  case result of+    Right expanded -> pure (Right expanded)+    Left err -> do+      info <- readOriginInfo targetDir+      let repair = case info of+            Just origin -> "Retry: seihou install " <> origin ^. #sourceUrl <> " --module " <> target ^. #name . #unRecipeName+            Nothing -> "Restore the required local recipes and members, or install the derived recipe from its declaring registry."+      pure (Left (ValidationError targetName ["Recipe '" <> target ^. #name . #unRecipeName <> "': " <> describe err, repair]))+  where+    targetName = ModuleName (target ^. #name . #unRecipeName)+    failure :: T.Text -> ExceptT ModuleLoadError IO a+    failure msg = ExceptT (pure (Left (ValidationError targetName [msg])))+    visit active descriptor dir = do+      _ <- ExceptT $ pure $ either (Left . ValidationError targetName) Right (validateRecipe descriptor)+      origin <- liftIO (detectArtifactOrigin projectRoot dir)+      let name = descriptor ^. #name+      when (any (\(n, o) -> n == name && sameArtifactIdentity o origin) active) $+        failure ("Recipe base cycle: " <> T.intercalate " -> " (map ((^. #unRecipeName) . fst) (reverse active) <> [name ^. #unRecipeName]))+      parents <- case descriptor ^. #extends of+        Nothing -> pure []+        Just ref -> do+          foundResult <- liftIO (discoverRunnable paths (ModuleName (ref ^. #recipe . #unRecipeName)))+          found <- case foundResult of+            Left err -> failure ("Base chain " <> T.intercalate " -> " (map ((^. #unRecipeName) . fst) (reverse ((name, origin) : active)) <> [ref ^. #recipe . #unRecipeName]) <> ": " <> describe err)+            Right value -> pure value+          case found of+            RunnableRecipe base baseDir -> do+              case ref ^. #source of+                Nothing -> pure ()+                Just required -> do+                  actual <- liftIO (readOriginInfo baseDir)+                  unless (maybe False (\info -> normalizeOriginUrl (info ^. #sourceUrl) == normalizeOriginUrl required) actual) $+                    failure ("Base '" <> ref ^. #recipe . #unRecipeName <> "' requires " <> required <> "; resolved origin is different or unknown")+              case validateRecipeVersion ref base of+                Left errors -> failure ("Base '" <> ref ^. #recipe . #unRecipeName <> "' from " <> maybe "local discovery" id (ref ^. #source) <> ": " <> T.intercalate "; " errors)+                Right () -> pure ()+              visit ((name, origin) : active) base baseDir+            _ -> failure ("Expected recipe base '" <> ref ^. #recipe . #unRecipeName <> "'")+      ExceptT (verifyDependencySources paths dir (descriptor ^. #modules))+      members <- forM (descriptor ^. #modules) $ \dep -> do+        memberDir <- ExceptT (discoverModule paths (dep ^. #module_))+        memberOrigin <- liftIO (detectArtifactOrigin projectRoot memberDir)+        pure (ResolvedRecipeMember dep name origin dir memberOrigin)+      pure (parents <> [ResolvedRecipeNode descriptor origin dir members])++-- Keep local discovery failures useful without exposing Haskell constructors.+describe :: ModuleLoadError -> T.Text+describe (ModuleNotFound (ModuleName name) _) = "Required recipe or member '" <> name <> "' was not found locally"+describe (DhallEvalError _ reason) = "Cannot evaluate descriptor: " <> reason+describe (DhallDecodeError _ reason) = "Cannot decode descriptor: " <> reason+describe (ValidationError _ reasons) = T.intercalate "; " reasons+describe (CircularDependency names) = "Dependency cycle: " <> T.intercalate " -> " [name | ModuleName name <- names]+describe (MissingSourceFile (ModuleName name) path) = "Member '" <> name <> "' is missing " <> T.pack path+describe (RegistryEvalError source reason) = "Cannot evaluate registry '" <> source <> "': " <> reason++-- | Descriptor evidence is normalized Dhall, independent of import/cache paths.+recordRecipeChain :: ExpandedRecipe -> IO [AppliedRecipeNode]+recordRecipeChain expanded = forM (expanded ^. #chain) $ \node -> do+  canonical <- normalizeDhallFile (node ^. #directory </> "recipe.dhall")+  pure (AppliedRecipeNode (node ^. #definition . #name) (node ^. #origin) (node ^. #definition . #version) (hashContent canonical))

@@ -9,6 +9,7 @@     resolveWithPromptPermission,     RecipeInputSpec (..),     resolveRecipeWithPrompts,+    resolveRecipeWithSources,     varValueToText,     exportedVars,     collectParentVars,@@ -329,11 +330,31 @@   Map VarName Text ->   Map VarName Text ->   Eff es (Either [VarError] (Map VarName ResolvedVar, Map ModuleInstance (Map VarName ResolvedVar)))-resolveRecipeWithPrompts permission confirmRecipe (RecipeInputSpec decls prompts recorded) modules saved cli literals env ns ctx local nsCfg ctxCfg global = do+resolveRecipeWithPrompts permission confirmRecipe spec modules saved cli literals =+  resolveRecipeWithSources permission confirmRecipe spec modules saved cli (Map.map (\raw -> (raw, FromRecipeBinding)) literals)++resolveRecipeWithSources ::+  (Console :> es) =>+  PromptPermission ->+  Bool ->+  RecipeInputSpec ->+  [(ModuleInstance, Module, FilePath)] ->+  SavedInstanceValues ->+  Map VarName Text ->+  Map VarName (Text, VarSource) ->+  Map Text Text ->+  Text ->+  Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Eff es (Either [VarError] (Map VarName ResolvedVar, Map ModuleInstance (Map VarName ResolvedVar)))+resolveRecipeWithSources permission confirmRecipe (RecipeInputSpec decls prompts recorded) modules saved cli literals env ns ctx local nsCfg ctxCfg global = do   interactive <- case permission of     PromptsForbidden -> pure False     PromptsAllowed -> isInteractive-  let explicit = Map.union (Map.map (\raw -> (raw, FromCLI)) cli) (Map.map (\raw -> (raw, FromRecipeBinding)) literals)+  let explicit = Map.union (Map.map (\raw -> (raw, FromCLI)) cli) literals       historical d =         nubOrdBy           id

@@ -67,7 +67,8 @@       commandReceipts = Map.empty,       checkoutCommands = [],       recipeInputs = Nothing,-      appliedAt = now+      appliedAt = now,+      recipeChain = Nothing     }   where     buildInstance (inst, modul, origin) =

@@ -1,11 +1,13 @@ module Seihou.Core.Recipe   ( validateRecipe,+    validateRecipeVersion,   ) where  import Control.Lens ((^.)) import Data.Generics.Labels () import Data.Map.Strict qualified as Map+import Data.Maybe (isNothing) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T@@ -13,6 +15,7 @@ import Seihou.Core.Module (isValidModuleName) import Seihou.Core.Types import Seihou.Core.Variable (isValidVarBindingName, validateVarPattern)+import Seihou.Core.Version (Version, parseVersion)  -- | Validate a 'Recipe' against recipe-specific rules. -- Returns 'Right' with the recipe if all rules pass, or 'Left' with a@@ -20,11 +23,11 @@ -- -- Validation rules: --   1. Name matches @[a-z][a-z0-9-]*@---   2. At least one module listed+--   2. A root lists at least one module; a derived recipe may add none --   3. No duplicate module names in the list --   4. All variable binding names in module entries match @[a-z][A-Za-z0-9.-]*@ --   5. Recipe variable declarations are unique---   6. Prompt targets and condition references name declared recipe variables+--   6. Flat prompt references are local; inherited references are checked on expansion validateRecipe :: Recipe -> Either [Text] Recipe validateRecipe recipe =   let errs =@@ -33,6 +36,7 @@           <> checkNoDuplicateModules recipe           <> checkVarBindingNames recipe           <> checkRecipeVarsAndPrompts recipe+          <> checkExtension recipe    in if null errs         then Right recipe         else Left errs@@ -48,7 +52,7 @@ -- Rule 2: At least one module must be listed checkNonEmptyModules :: Recipe -> [Text] checkNonEmptyModules recipe-  | null (recipe ^. #modules) = ["modules: recipe must list at least one module"]+  | null (recipe ^. #modules) && isNothing (recipe ^. #extends) = ["modules: recipe must list at least one module"]   | otherwise = []  -- Rule 3: No duplicate module names@@ -66,7 +70,7 @@ -- Rule 4: Variable binding names must match [a-z][A-Za-z0-9.-]* checkVarBindingNames :: Recipe -> [Text] checkVarBindingNames recipe =-  concatMap checkDep (recipe ^. #modules)+  concatMap checkDep (recipe ^. #modules <> [Dependency (o ^. #module_) (o ^. #vars) Nothing | o <- recipe ^. #moduleOverrides])   where     checkDep dep =       concatMap@@ -94,4 +98,57 @@       patternErrors = ["vars: '" <> name <> "' " <> msg | d <- recipe ^. #vars, Left (ValidationFailed (VarName name) msg) <- [validateVarPattern d]]    in patternErrors         <> map (\name -> "vars: duplicate variable declaration '" <> name <> "'") (findDupes Set.empty Set.empty names)-        <> concatMap promptErrors (recipe ^. #prompts)+        <> (if isNothing (recipe ^. #extends) then concatMap promptErrors (recipe ^. #prompts) else [])++-- | Producer intervals are requirements, independent of consumer downgrade flags.+validateRecipeVersion :: RecipeReference -> Recipe -> Either [Text] ()+validateRecipeVersion ref base = case ref ^. #versionRange of+  Nothing -> Right ()+  Just range -> case (parseNumericVersion (range ^. #minimum), parseNumericVersion (range ^. #before), (base ^. #version) >>= parseNumericVersion) of+    (Just low, Just high, Just selected) | low < high && low <= selected && selected < high -> Right ()+    _ ->+      Left+        [ "Base '"+            <> ref ^. #recipe . #unRecipeName+            <> "' version "+            <> maybe "<unversioned>" id (base ^. #version)+            <> " is outside required interval ["+            <> range ^. #minimum+            <> ", "+            <> range ^. #before+            <> ")"+        ]++checkExtension :: Recipe -> [Text]+checkExtension recipe =+  let overrides = recipe ^. #moduleOverrides+      promptOverrides = recipe ^. #promptOverrides+      names = map (^. #module_ . #unModuleName) overrides+      targets = map (^. #var . #unVarName) promptOverrides+      localNames = map (^. #module_ . #unModuleName) (recipe ^. #modules)+      localTargets = map (^. #var . #unVarName) (recipe ^. #prompts)+      badSource src = T.null (T.strip src) || "${" `T.isInfixOf` src+      refErrors ref =+        ["extends.recipe: invalid recipe name" | not (isValidModuleName (ref ^. #recipe . #unRecipeName))]+          <> ["extends.source: expected a nonempty literal Git source" | Just src <- [ref ^. #source], badSource src]+          <> case ref ^. #versionRange of+            Nothing -> []+            Just range -> case (parseNumericVersion (range ^. #minimum), parseNumericVersion (range ^. #before)) of+              (Just low, Just high) | low < high -> []+              _ -> ["extends.versionRange: numeric minimum must be strictly below before"]+   in maybe [] refErrors (recipe ^. #extends)+        <> ["moduleOverrides: duplicate target '" <> n <> "'" | n <- findDupes Set.empty Set.empty names]+        <> ["promptOverrides: duplicate target '" <> n <> "'" | n <- findDupes Set.empty Set.empty targets]+        <> ["moduleOverrides: target also declared in modules: " <> n | n <- names, n `elem` localNames]+        <> ["promptOverrides: target also declared in prompts: " <> n | n <- targets, n `elem` localTargets]+        <> ["moduleOverrides: invalid module name: " <> n | n <- names, not (isValidModuleName n)]+        <> ["modules: invalid module name: " <> n | n <- localNames, not (isValidModuleName n)]+        <> ["modules.source: expected a nonempty literal Git source" | dep <- recipe ^. #modules, Just src <- [dep ^. #source], badSource src]+        <> ["overrides require extends" | isNothing (recipe ^. #extends), not (null overrides && null promptOverrides)]++-- Keep author intervals numeric even though the legacy parser accepts the+-- whitespace and sign syntax of Haskell's Read instance.+parseNumericVersion :: Text -> Maybe Version+parseNumericVersion raw+  | T.all (\c -> (c >= '0' && c <= '9') || c == '.') raw = parseVersion raw+  | otherwise = Nothing

@@ -34,6 +34,9 @@     Module (..),     RecipeName (..),     Recipe (..),+    RecipeReference (..),+    RecipeVersionRange (..),+    RecipeModuleOverride (..),     BlueprintFile (..),     Blueprint (..),     CommandVar (..),@@ -59,6 +62,7 @@     CommandReceipt (..),     AppliedInstanceState (..),     AppliedComposition (..),+    AppliedRecipeNode (..),     AppliedModule (..),     AppliedRecipe (..),     AppliedBlueprint (..),@@ -330,15 +334,39 @@   deriving stock (Eq, Ord, Show, Generic)   deriving newtype (IsString) --- | A recipe: a named, reusable composition of modules with optional--- pre-configured variable bindings.+-- | Inclusive minimum and exclusive upper bound on numeric recipe versions.+data RecipeVersionRange = RecipeVersionRange+  { minimum :: !Text,+    before :: !Text+  }+  deriving stock (Eq, Show, Generic)++-- | One parent, selected from its source default branch and checked locally.+data RecipeReference = RecipeReference+  { recipe :: !RecipeName,+    source :: !(Maybe Text),+    versionRange :: !(Maybe RecipeVersionRange)+  }+  deriving stock (Eq, Show, Generic)++-- | Literal changes to an inherited member; never a new executable instance.+data RecipeModuleOverride = RecipeModuleOverride+  { module_ :: !ModuleName,+    vars :: !(Map VarName Text)+  }+  deriving stock (Eq, Show, Generic)++-- | A named composition, optionally specializing one inherited recipe. data Recipe = Recipe   { name :: !RecipeName,     version :: !(Maybe Text),     description :: !(Maybe Text),     modules :: ![Dependency],     vars :: ![VarDecl],-    prompts :: ![Prompt]+    prompts :: ![Prompt],+    extends :: !(Maybe RecipeReference),+    moduleOverrides :: ![RecipeModuleOverride],+    promptOverrides :: ![Prompt]   }   deriving stock (Eq, Show, Generic) @@ -518,6 +546,7 @@ data VarSource   = FromCLI   | FromRecipeBinding+  | FromRecipeBindingAt RecipeName ArtifactOrigin   | FromApplication   | FromEnv Text   | FromLocalConfig@@ -600,6 +629,7 @@     TargetedAdditiveSharedPathUpdate   | SeedReceipts   | RecipeInputs+  | RecipeInheritance   | SeedOwnerClaims   | CheckoutLocalOutputs   | CheckoutLocalCommands@@ -742,6 +772,15 @@   }   deriving stock (Eq, Show, Generic) +-- | One recipe descriptor used by an accepted application, oldest first.+data AppliedRecipeNode = AppliedRecipeNode+  { name :: !RecipeName,+    origin :: !ArtifactOrigin,+    recipeVersion :: !(Maybe Text),+    descriptorHash :: !SHA256+  }+  deriving stock (Eq, Show, Generic)+ -- | A complete, re-runnable top-level module or recipe composition. data AppliedComposition = AppliedComposition   { applicationId :: !ApplicationId,@@ -755,6 +794,7 @@     commandReceipts :: !(Map CommandFingerprint CommandReceipt),     checkoutCommands :: ![CheckoutCommand],     recipeInputs :: !(Maybe (Map VarName Text)),+    recipeChain :: !(Maybe [AppliedRecipeNode]),     appliedAt :: !UTCTime   }   deriving stock (Eq, Show, Generic)

@@ -366,6 +366,11 @@ formatVarSource :: VarSource -> Text formatVarSource FromCLI = "--var" formatVarSource FromRecipeBinding = "literal recipe binding"+formatVarSource (FromRecipeBindingAt recipe origin) = "literal recipe binding from '" <> recipe ^. #unRecipeName <> "' (" <> sourceLabel origin <> ")"+  where+    sourceLabel (RemoteOrigin url _ _) = url+    sourceLabel (ProjectOrigin path) = T.pack path+    sourceLabel (LocalOrigin name) = name <> "; unverified local origin" formatVarSource FromApplication = "application" formatVarSource (FromEnv envKey) = "env " <> envKey formatVarSource FromLocalConfig = "local config"

@@ -132,7 +132,7 @@         mapM_ evaluate (r ^. #modules)         -- Force lazy decoder thunks that may contain 'error' calls         mapM_ (\v -> evaluate (forceType (v ^. #type_))) (r ^. #vars)-        mapM_ (\p -> evaluate (p ^. #condition)) (r ^. #prompts)+        mapM_ (\p -> evaluate (p ^. #condition)) ((r ^. #prompts) <> (r ^. #promptOverrides))         pure r       Failure e -> throwIO e   case result of@@ -283,7 +283,7 @@  -- | Decoder for the top-level Recipe type from Dhall. recipeDecoder :: Decoder Recipe-recipeDecoder = Decoder decodeRecipe (expected fieldsDecoder)+recipeDecoder = withDefaults [("extends", noneText), ("moduleOverrides", emptyRecordList), ("promptOverrides", emptyRecordList)] $ Decoder decodeRecipe (expected fieldsDecoder)   where     fieldsDecoder =       record@@ -294,6 +294,9 @@             <*> field "modules" (decodeContext "modules: expected a list of module names or records with module and vars bindings" (list dependencyDecoder))             <*> field "vars" (decodeContext "vars: expected variable declarations with name, type, default, description, required and validation fields" (list varDeclDecoder))             <*> field "prompts" (decodeContext "prompts: expected prompt records with var, text, when and choices fields" (list promptDecoder))+            <*> field "extends" (maybe recipeReferenceDecoder)+            <*> field "moduleOverrides" (list recipeModuleOverrideDecoder)+            <*> field "promptOverrides" (list promptDecoder)         )      decodeRecipe expr@(Dhall.RecordLit fields) =@@ -302,6 +305,24 @@         missing -> extractError ("recipe.dhall: missing fields: " <> T.intercalate ", " missing)     decodeRecipe _ = extractError "recipe.dhall: expected a recipe record" +recipeReferenceDecoder :: Decoder RecipeReference+recipeReferenceDecoder =+  withDefaults [("source", noneText), ("versionRange", noneText)] $+    record+      ( RecipeReference+          <$> field "recipe" recipeNameDecoder+          <*> field "source" (maybe strictText)+          <*> field "versionRange" (maybe (record (RecipeVersionRange <$> field "minimum" strictText <*> field "before" strictText)))+      )++recipeModuleOverrideDecoder :: Decoder RecipeModuleOverride+recipeModuleOverrideDecoder =+  record+    ( RecipeModuleOverride+        <$> field "module" moduleNameDecoder+        <*> field "vars" (Map.fromList <$> list (record ((,) <$> field "name" varNameDecoder <*> field "value" strictText)))+    )+ -- Dhall extraction bypasses a single expected type to support both dependency -- forms. Give extraction failures author-facing field context rather than an -- internal InvalidDecoder report (which cannot name the enclosing field).@@ -882,7 +903,11 @@         Just (Dhall.Some _) -> Dhall.RecordLit fields         _ -> Dhall.RecordLit (DhallMap.insert "source" sourceField fields)     edge other = other-    rewrite (Dhall.RecordLit fields) = Dhall.RecordLit (foldl' update fields ["dependencies", "modules", "baseModules"])+    rewrite (Dhall.RecordLit fields) =+      let sourced = foldl' update fields ["dependencies", "modules", "baseModules"]+       in Dhall.RecordLit $ case recordFieldValue <$> DhallMap.lookup "extends" sourced of+            Just (Dhall.Some ref) -> DhallMap.insert "extends" (makeRecordField (Dhall.Some (edge ref))) sourced+            _ -> sourced     rewrite other = other     update fields key = case recordFieldValue <$> DhallMap.lookup key fields of       Just (Dhall.ListLit annotation values)

@@ -23,6 +23,7 @@ import Data.Aeson.KeyMap qualified as KM import Data.Aeson.Types qualified as Aeson import Data.ByteString.Lazy qualified as LBS+import Data.Char (isHexDigit) import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe, isJust)@@ -30,10 +31,11 @@ import Data.Text qualified as T import Data.Time (UTCTime) import Seihou.Composition.Instance (ModuleInstance (..), qualifiedName)-import Seihou.Core.ArtifactIdentity (sameArtifactIdentity)+import Seihou.Core.ArtifactIdentity (isMachineLocalOriginUrl, sameArtifactIdentity) import Seihou.Core.Checkout (CheckoutError (..), validateCheckoutRecords) import Seihou.Core.CommandFingerprint (checkoutCommandOperation, fingerprintCommand)-import Seihou.Core.Path (validateCanonicalProjectPath)+import Seihou.Core.Module (isValidModuleName)+import Seihou.Core.Path (validateCanonicalProjectPath, validateProjectRelativePath) import Seihou.Core.Seed (renderManifestInvariantError, seedApplicationIds, validateManifestInvariants) import Seihou.Core.Types import Seihou.Manifest.Hash (baselineRefFromText)@@ -79,8 +81,9 @@ -- step lives in "Seihou.Manifest.Upgrade"; the rule that every semantic -- change advances this number is -- docs/adr/0014-every-semantic-manifest-change-advances-the-schema-version.md.+-- Schema 13 records application recipe-chain evidence; null denotes unknown history. currentManifestVersion :: ManifestSchemaVersion-currentManifestVersion = ManifestSchemaVersion 12+currentManifestVersion = ManifestSchemaVersion 13  -- | The oldest schema the ordinary decoder reads. Anything older records -- machine-specific absolute paths and must go through the explicit@@ -95,6 +98,7 @@ minimumManifestVersion TargetedAdditiveSharedPathUpdate = ManifestSchemaVersion 7 minimumManifestVersion SeedReceipts = ManifestSchemaVersion 8 minimumManifestVersion RecipeInputs = ManifestSchemaVersion 12+minimumManifestVersion RecipeInheritance = ManifestSchemaVersion 13 minimumManifestVersion SeedOwnerClaims = ManifestSchemaVersion 11 minimumManifestVersion CheckoutLocalOutputs = ManifestSchemaVersion 9 minimumManifestVersion CheckoutLocalCommands = ManifestSchemaVersion 10@@ -399,6 +403,7 @@       ++ maybe [] (\v -> ["context" .= v]) (composition ^. #context)       ++ ["checkoutCommands" .= map checkoutCommandToJSON (composition ^. #checkoutCommands) | schema >= ManifestSchemaVersion 10]       ++ ["recipeInputs" .= fmap varsToJSON (composition ^. #recipeInputs) | schema >= ManifestSchemaVersion 12]+      ++ ["recipeChain" .= (composition ^. #recipeChain) | schema >= minimumManifestVersion RecipeInheritance]       ++ commandReceiptsField (composition ^. #commandReceipts)   where     commandReceiptsField receipts@@ -420,20 +425,64 @@         legacy <- o Aeson..:? "checkoutCommands" Aeson..!= ([] :: [Aeson.Value])         unless (null legacy) (fail "checkout commands require manifest schema 10")         pure []-  AppliedComposition-    <$> (ApplicationId <$> o .: "applicationId")-    <*> o .: "target"-    <*> o .: "targetOrigin"-    <*> o Aeson..:? "targetVersion"-    <*> (map ModuleName <$> o Aeson..:? "additionalModules" Aeson..!= [])-    <*> o Aeson..:? "namespace"-    <*> o Aeson..:? "context"-    <*> o Aeson..:? "instances" Aeson..!= []-    <*> (commandReceiptsFromJSON =<< o Aeson..:? "commandReceipts" Aeson..!= Aeson.object [])-    <*> pure commands-    <*> (if schema >= ManifestSchemaVersion 12 then traverse varsFromJSON =<< o .: "recipeInputs" else pure Nothing)-    <*> o .: "appliedAt"+  when (schema < minimumManifestVersion RecipeInheritance) $ do+    legacyChain <- o Aeson..:? "recipeChain" :: Aeson.Parser (Maybe Aeson.Value)+    unless (legacyChain == Nothing) (fail "recipe chain requires manifest schema 13")+  composition <-+    AppliedComposition+      <$> (ApplicationId <$> o .: "applicationId")+      <*> o .: "target"+      <*> o .: "targetOrigin"+      <*> o Aeson..:? "targetVersion"+      <*> (map ModuleName <$> o Aeson..:? "additionalModules" Aeson..!= [])+      <*> o Aeson..:? "namespace"+      <*> o Aeson..:? "context"+      <*> o Aeson..:? "instances" Aeson..!= []+      <*> (commandReceiptsFromJSON =<< o Aeson..:? "commandReceipts" Aeson..!= Aeson.object [])+      <*> pure commands+      <*> (if schema >= ManifestSchemaVersion 12 then traverse varsFromJSON =<< o .: "recipeInputs" else pure Nothing)+      <*> (if schema >= minimumManifestVersion RecipeInheritance then o .: "recipeChain" else pure Nothing)+      <*> o .: "appliedAt"+  either (fail . T.unpack) pure (validateRecipeChain composition)+  pure composition +validateRecipeChain :: AppliedComposition -> Either Text ()+validateRecipeChain composition = case composition ^. #recipeChain of+  Nothing -> Right ()+  Just nodes -> do+    mapM_ validateRecipeNode nodes+    unless (length nodes == Set.size (Set.fromList (map (^. #name . #unRecipeName) nodes))) (Left "recipe chain has duplicate names")+    case composition ^. #target of+      AppliedModuleTarget _ -> unless (null nodes) (Left "module application must have an empty recipe chain")+      AppliedRecipeTarget target -> case reverse nodes of+        [] -> Left "recipe application must have a nonempty recorded chain"+        lastNode : _ ->+          unless+            (lastNode ^. #name == target && sameArtifactIdentity (lastNode ^. #origin) (composition ^. #targetOrigin) && lastNode ^. #recipeVersion == composition ^. #targetVersion)+            (Left "recipe chain final node must match the application target identity and version")++validateRecipeNode :: AppliedRecipeNode -> Either Text ()+validateRecipeNode node = do+  let name = node ^. #name . #unRecipeName+      digest = node ^. #descriptorHash . #unSHA256+  unless (isValidModuleName name) (Left "recipe chain name is invalid")+  unless (T.length digest == 64 && T.all isHexDigit digest) (Left "recipe descriptorHash must be SHA-256 hexadecimal")+  case node ^. #origin of+    ProjectOrigin path -> unless (path == ".") (() <$ validateProjectRelativePath (T.pack path))+    LocalOrigin artifact -> unless (artifact == name) (Left "recipe local origin must name its recipe")+    RemoteOrigin source artifact _ -> do+      unless (artifact == name) (Left "recipe remote origin must name its recipe")+      when (T.null source || isMachineLocalOriginUrl source) (Left "recipe remote origin must be a portable Git source")++instance ToJSON AppliedRecipeNode where+  toJSON node = Aeson.object ["name" .= (node ^. #name . #unRecipeName), "origin" .= (node ^. #origin), "version" .= (node ^. #recipeVersion), "descriptorHash" .= (node ^. #descriptorHash . #unSHA256)]++instance FromJSON AppliedRecipeNode where+  parseJSON = Aeson.withObject "AppliedRecipeNode" $ \o -> do+    digest <- o .: "descriptorHash"+    unless (T.length digest == 64 && T.all isHexDigit digest) (fail "recipe descriptorHash must be SHA-256 hexadecimal")+    AppliedRecipeNode <$> (RecipeName <$> o .: "name") <*> o .: "origin" <*> o Aeson..:? "version" <*> pure (SHA256 (T.toLower digest))+ instance ToJSON CommandReceipt where   toJSON receipt =     Aeson.object $@@ -849,6 +898,8 @@ manifestEncodingLoss :: Manifest -> [Text] manifestEncodingLoss manifest =   either (pure . renderManifestInvariantError) (const []) (validateManifestInvariants manifest)+    <> ["recipe chain requires manifest schema 13" | not (manifestSupports RecipeInheritance manifest), any (isJust . (^. #recipeChain)) (manifest ^. #applications)]+    <> concat [either pure (const []) (validateRecipeChain application) | application <- manifest ^. #applications]     <> ["recipe inputs require manifest schema 12" | not (manifestSupports RecipeInputs manifest), any (isJust . (^. #recipeInputs)) (manifest ^. #applications)]     <> ["seed owner claims require manifest schema 11" | not (manifestSupports SeedOwnerClaims manifest), any (\r -> case r ^. #ownership of KnownSeedOwners _ -> True; _ -> False) (Map.elems (manifest ^. #seeds))]     <> either (pure . T.pack) (const []) (Aeson.parseEither (const (validateCheckoutCommands manifest)) Aeson.Null)

@@ -60,6 +60,7 @@   | AddEmptySeedReceipts   | AddEmptyCheckoutOutputs   | AddUnknownRecipeInputs+  | AddUnknownRecipeChain   | MakeSeedOwnershipExplicit   | AddEmptyCheckoutCommands   deriving stock (Eq, Ord, Show, Enum, Bounded, Generic)@@ -124,7 +125,8 @@     step 8 AddEmptyCheckoutOutputs "checkout outputs",     step 9 AddEmptyCheckoutCommands "repeatable checkout commands",     step 10 MakeSeedOwnershipExplicit "explicit seed instance ownership",-    step 11 AddUnknownRecipeInputs "recipe inputs"+    step 11 AddUnknownRecipeInputs "recipe inputs",+    step 12 AddUnknownRecipeChain "recipe inheritance provenance"   ]   where     step from stepAction =@@ -132,6 +134,7 @@  upgradeStepKind :: UpgradeStepAction -> UpgradeStepKind upgradeStepKind AddUnknownRecipeInputs = LosslessUpgrade+upgradeStepKind AddUnknownRecipeChain = LosslessUpgrade upgradeStepKind StampVersion = LosslessUpgrade upgradeStepKind ConvertMachineLocalPaths = InferenceBearingUpgrade upgradeStepKind MakeSharedWriteEvidenceExplicit = LosslessUpgrade@@ -193,6 +196,19 @@   unless (actual == upgradeStep ^. #fromVersion) $     Left (StepVersionMismatch upgradeStep actual)   transformed <- case upgradeStep ^. #action of+    AddUnknownRecipeChain -> case document of+      Aeson.Object fields -> do+        apps <- case KeyMap.lookup "applications" fields of+          Nothing -> Right []+          Just value -> first (MalformedDocument actual . T.pack) (Aeson.fromJSON value & \case Aeson.Error err -> Left err; Aeson.Success xs -> Right (xs :: [Aeson.Value]))+        upgraded <- forM apps $ \case+          Aeson.Object app -> case KeyMap.lookup "recipeChain" app of+            Nothing -> Right (Aeson.Object (KeyMap.insert "recipeChain" Aeson.Null app))+            Just Aeson.Null -> Right (Aeson.Object app)+            _ -> Left (MalformedDocument actual "schema 12 cannot contain recipe chain evidence")+          _ -> Left (MalformedDocument actual "application must be an object")+        Right (Aeson.Object (KeyMap.insert "applications" (Aeson.toJSON upgraded) fields))+      _ -> Left (MalformedDocument actual "manifest must be an object")     AddUnknownRecipeInputs -> case document of       Aeson.Object fields -> Right (Aeson.Object (KeyMap.insert "applications" (addInputs (fromMaybe (Aeson.Array mempty) (KeyMap.lookup "applications" fields))) fields))       _ -> Right document

@@ -1,10 +1,18 @@ module Seihou.Composition.RecipeSpec (tests) where +import Control.Lens ((&), (.~), (^.))+import Data.Either (isLeft)+import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Text (Text)-import Seihou.Composition.Recipe (expandRecipe)+import Data.Text qualified as T+import Seihou.Composition.Recipe+import Seihou.Composition.RecipeChain (loadRecipeChain) import Seihou.Core.Recipe (validateRecipe) import Seihou.Core.Types+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory) import Test.Hspec import Test.Tasty import Test.Tasty.Hspec (testSpec)@@ -20,9 +28,102 @@  spec :: Spec spec = do+  describe "loadRecipeChain" $ do+    it "reports indirect base cycles before looking up members" $ do+      withSystemTempDirectory "recipe-chain-cycle" $ \dir -> do+        let child = derived "child" "base"+        createDirectoryIfMissing True (dir </> "base")+        writeFile+          (dir </> "base" </> "recipe.dhall")+          "{ name = \"base\", version = None Text, description = None Text, modules = [] : List Text, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }, prompts = [] : List {var : Text, text : Text, when : Optional Text, choices : Optional (List Text)}, extends = Some {recipe = \"child\"} }"+        writeChildDescriptor dir+        result <- loadRecipeChain dir [dir] child (dir </> "child")+        case result of+          Left (ValidationError _ messages) -> T.unwords messages `shouldSatisfy` T.isInfixOf "child -> base -> child"+          other -> expectationFailure (show other)++    it "rejects an explicit source with unknown local provenance" $ do+      withSystemTempDirectory "recipe-chain-origin" $ \dir -> do+        let child = derived "child" "base" & #extends .~ Just (RecipeReference "base" (Just "https://example.com/registry") Nothing)+        createDirectoryIfMissing True (dir </> "base")+        writeFile+          (dir </> "base" </> "recipe.dhall")+          "{ name = \"base\", version = None Text, description = None Text, modules = [\"one\"], vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }, prompts = [] : List {var : Text, text : Text, when : Optional Text, choices : Optional (List Text)} }"+        result <- loadRecipeChain dir [dir] child (dir </> "child")+        case result of+          Left (ValidationError _ messages) -> T.unwords messages `shouldSatisfy` T.isInfixOf "different or unknown"+          other -> expectationFailure (show other)++  describe "mergeRecipeChain" $ do+    it "keeps oldest primary, deduplicates members, and preserves override attribution across three layers" $ do+      let base = flat "base" [bound "one" "old", bound "two" "old"]+          child = derived "child" "base" & #moduleOverrides .~ [RecipeModuleOverride "one" (Map.singleton "x" "new")]+          grandchild = derived "grandchild" "child"+      case mergeRecipeChain (map node [base, child, grandchild]) of+        Left errs -> expectationFailure (show errs)+        Right expanded -> do+          expanded ^. #primary `shouldBe` "one"+          map (^. #dependency . #module_) (expanded ^. #members) `shouldBe` ["one", "two"]+          fmap (^. #value) (Map.lookup "x" (expanded ^. #literals)) `shouldBe` Just "new"+          fmap (^. #recipe) (Map.lookup "x" (expanded ^. #literals)) `shouldBe` Just "child"++    it "rejects unequal same-layer literals across additions and overrides" $ do+      let base = flat "base" [bound "one" "old"]+          child =+            derived "child" "base"+              & #modules .~ [bound "two" "different"]+              & #moduleOverrides .~ [RecipeModuleOverride "one" (Map.singleton "x" "new")]+      mergeRecipeChain (map node [base, child]) `shouldSatisfy` isLeft++    it "retains a literal when a child supplies only a declaration default" $ do+      let decl = VarDecl "x" VTText Nothing Nothing False Nothing+          base = flat "base" [bound "one" "literal"] & #vars .~ [decl]+          child = derived "child" "base" & #vars .~ [decl & #default_ .~ Just (VText "default")]+      case mergeRecipeChain (map node [base, child]) of+        Left errs -> expectationFailure (show errs)+        Right expanded -> fmap (^. #value) (Map.lookup "x" (expanded ^. #literals)) `shouldBe` Just "literal"++    it "rejects constraint changes and preserves explicitly empty descriptions" $ do+      let decl = VarDecl "x" VTText Nothing (Just "parent") False Nothing+          base = flat "base" [simpleDep "one"] & #vars .~ [decl]+          child = derived "child" "base" & #vars .~ [decl & #description .~ Just ""]+      fmap (^. #declarations) (mergeRecipeChain (map node [base, child])) `shouldBe` Right [decl & #description .~ Just ""]+      mergeRecipeChain (map node [base, child & #vars .~ [decl & #required .~ True]]) `shouldSatisfy` isLeft++    it "replaces inherited prompts in place and resolves inherited declarations" $ do+      let decl = VarDecl "x" VTText Nothing Nothing False Nothing+          question = Prompt "x" "Old?" Nothing Nothing+          replacement = question & #text .~ "New?"+          base = flat "base" [simpleDep "one"] & #vars .~ [decl] & #prompts .~ [question]+          child = derived "child" "base" & #promptOverrides .~ [replacement]+      fmap (^. #prompts) (mergeRecipeChain (map node [base, child])) `shouldBe` Right [replacement]+      mergeRecipeChain (map node [base, child & #promptOverrides .~ [] & #prompts .~ [replacement]]) `shouldSatisfy` isLeft++    it "rejects a repeated member from another origin" $ do+      let base = flat "base" [simpleDep "one"]+          child = derived "child" "base" & #modules .~ [simpleDep "one"]+          childNode = node child & #members .~ [m & #memberOrigin .~ RemoteOrigin "https://other.example/repo" "one" Nothing | m <- node child ^. #members]+      mergeRecipeChain [node base, childNode] `shouldSatisfy` isLeft++    it "deduplicates compatible repeated members and rejects missing override targets" $ do+      let base = flat "base" [simpleDep "one"]+          child = derived "child" "base" & #modules .~ [simpleDep "one"]+      fmap (length . (^. #members)) (mergeRecipeChain (map node [base, child])) `shouldBe` Right 1+      mergeRecipeChain (map node [base, derived "child" "base" & #moduleOverrides .~ [RecipeModuleOverride "missing" mempty]]) `shouldSatisfy` isLeft++    it "enforces exclusive upper bounds and trailing-zero version equivalence" $ do+      let base = flat "base" [simpleDep "one"] & #version .~ Just "1.0.0"+          child = derived "child" "base" & #extends .~ Just (RecipeReference "base" Nothing (Just (RecipeVersionRange "1" "2")))+      mergeRecipeChain (map node [base, child]) `shouldSatisfy` either (const False) (const True)+      mergeRecipeChain (map node [base & #version .~ Just "2", child]) `shouldSatisfy` isLeft+      mergeRecipeChain (map node [base & #version .~ Nothing, child]) `shouldSatisfy` isLeft++    it "does not silently expand an unresolved base through the legacy API" $ do+      expandRecipe (derived "child" "base") `shouldSatisfy` isLeft+   describe "expandRecipe" $ do     it "keeps the first camelCase binding across the flattened composition" $ do-      let recipe = Recipe "policy" Nothing Nothing [Dependency "one" (Map.singleton "git.githubOwner" "first") Nothing, Dependency "two" (Map.singleton "git.githubOwner" "second") Nothing] [] []+      let recipe = Recipe "policy" Nothing Nothing [Dependency "one" (Map.singleton "git.githubOwner" "first") Nothing, Dependency "two" (Map.singleton "git.githubOwner" "second") Nothing] [] [] Nothing [] []           (_, _, overrides, _, _, _) = expectExpanded recipe       Map.lookup "git.githubOwner" overrides `shouldBe` Just "first" @@ -38,7 +139,10 @@                     simpleDep "mod-c"                   ],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }           (primary, additional, _, _, _, requirements) = expectExpanded recipe       primary `shouldBe` ModuleName "mod-a"@@ -56,7 +160,10 @@                     Dependency (ModuleName "nix") (Map.singleton "nix.system" "aarch64-darwin") Nothing                   ],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }           (_, _, overrides, _, _, _) = expectExpanded recipe       Map.lookup (VarName "project.name") overrides `shouldBe` Just "my-app"@@ -86,7 +193,10 @@                 description = Nothing,                 modules = [simpleDep "base"],                 vars = [recipeVar],-                prompts = [recipePrompt]+                prompts = [recipePrompt],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }           (_, _, _, vars, prompts, _) = expectExpanded recipe       vars `shouldBe` [recipeVar]@@ -100,7 +210,10 @@                 description = Nothing,                 modules = [simpleDep "the-module"],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }           (primary, additional, overrides, _, _, _) = expectExpanded recipe       primary `shouldBe` ModuleName "the-module"@@ -115,7 +228,10 @@                 description = Nothing,                 modules = [],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }       expandRecipe recipe `shouldBe` Left ["modules: recipe must list at least one module"] @@ -128,8 +244,32 @@               [simpleDep "unavailable"]               []               [Prompt "missing-target" "Question" (Just (ExprNot (ExprIsSet "missing-condition"))) Nothing]+              Nothing+              []+              []       case validateRecipe recipe of         Left errors -> do           length errors `shouldBe` 2           expandRecipe recipe `shouldBe` Left errors         Right _ -> expectationFailure "Expected malformed prompt references to fail"++flat :: RecipeName -> [Dependency] -> Recipe+flat name deps = Recipe name Nothing Nothing deps [] [] Nothing [] []++derived :: RecipeName -> RecipeName -> Recipe+derived name base = flat name [] & #extends .~ Just (RecipeReference base Nothing Nothing)++bound :: ModuleName -> Text -> Dependency+bound name value = Dependency name (Map.singleton "x" value) Nothing++node :: Recipe -> ResolvedRecipeNode+node recipe = ResolvedRecipeNode recipe origin "." [ResolvedRecipeMember dep (recipe ^. #name) origin "." (LocalOrigin (dep ^. #module_ . #unModuleName)) | dep <- recipe ^. #modules]+  where+    origin = LocalOrigin (recipe ^. #name . #unRecipeName)++writeChildDescriptor :: FilePath -> IO ()+writeChildDescriptor dir = do+  createDirectoryIfMissing True (dir </> "child")+  writeFile+    (dir </> "child" </> "recipe.dhall")+    "{ name = \"child\", version = None Text, description = None Text, modules = [] : List Text, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }, prompts = [] : List {var : Text, text : Text, when : Optional Text, choices : Optional (List Text)}, extends = Some {recipe = \"base\"} }"

@@ -71,7 +71,8 @@       commandReceipts = Map.empty,       checkoutCommands = [],       recipeInputs = Nothing,-      appliedAt = fixedTime+      appliedAt = fixedTime,+      recipeChain = Nothing     }  spec :: Spec

@@ -1,6 +1,7 @@ module Seihou.Core.RecipeSpec (tests) where  import Control.Lens ((&), (.~))+import Data.Either (isLeft) import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Text qualified as T@@ -19,6 +20,38 @@ spec :: Spec spec = do   describe "validateRecipe" $ do+    it "validates settings-only children without discovering inherited prompt names" $ do+      let recipe =+            interactiveRecipe+              & #modules .~ []+              & #vars .~ []+              & #extends .~ Just (RecipeReference "missing-base" Nothing Nothing)+              & #moduleOverrides .~ [RecipeModuleOverride "inherited" mempty]+      validateRecipe recipe `shouldBe` Right recipe++    it "rejects malformed references, reversed intervals, and duplicate override targets" $ do+      let base = interactiveRecipe & #extends .~ Just (RecipeReference "base" Nothing Nothing)+      mapM_+        (\ref -> validateRecipe (base & #extends .~ Just ref) `shouldSatisfy` isLeft)+        [ RecipeReference "BadName" Nothing Nothing,+          RecipeReference "base" (Just "${source}") Nothing,+          RecipeReference "base" Nothing (Just (RecipeVersionRange "2" "1")),+          RecipeReference "base" Nothing (Just (RecipeVersionRange "1.0" "1")),+          RecipeReference "base" Nothing (Just (RecipeVersionRange "latest" "2")),+          RecipeReference "base" Nothing (Just (RecipeVersionRange "+1" "2"))+        ]+      validateRecipe (base & #moduleOverrides .~ replicate 2 (RecipeModuleOverride "inherited" mempty)) `shouldSatisfy` isLeft+      validateRecipe (base & #promptOverrides .~ replicate 2 (Prompt "inherited" "Question?" Nothing Nothing)) `shouldSatisfy` isLeft++    it "rejects overriding an addition or overriding without a base" $ do+      validateRecipe (interactiveRecipe & #moduleOverrides .~ [RecipeModuleOverride "inherited" mempty]) `shouldSatisfy` isLeft+      validateRecipe+        ( interactiveRecipe+            & #extends .~ Just (RecipeReference "base" Nothing Nothing)+            & #moduleOverrides .~ [RecipeModuleOverride "unavailable" mempty]+        )+        `shouldSatisfy` isLeft+     it "accepts camelCase bindings without recipe declarations or installed members" $ do       let recipe = interactiveRecipe & #modules .~ [Dependency "unavailable" (Map.fromList [("git.githubOwner", "tan"), ("git.createGithub", "true"), ("git.githubVisibility", "private")]) Nothing]       validateRecipe recipe `shouldBe` Right recipe@@ -31,7 +64,10 @@                 description = Just "A valid recipe",                 modules = [simpleDep "mod-a", simpleDep "mod-b"],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }       validateRecipe recipe `shouldBe` Right recipe @@ -43,7 +79,10 @@                 description = Nothing,                 modules = [],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }       case validateRecipe recipe of         Left errs -> hasError "at least one module" errs `shouldBe` True@@ -57,7 +96,10 @@                 description = Nothing,                 modules = [simpleDep "mod-a"],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }       case validateRecipe recipe of         Left errs -> hasError "recipe name must match" errs `shouldBe` True@@ -71,7 +113,10 @@                 description = Nothing,                 modules = [simpleDep "mod-a", simpleDep "mod-b", simpleDep "mod-a"],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }       case validateRecipe recipe of         Left errs -> hasError "duplicate module" errs `shouldBe` True@@ -87,7 +132,10 @@                   [ Dependency (ModuleName "mod-a") (Map.singleton (VarName "INVALID") "val") Nothing                   ],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }       case validateRecipe recipe of         Left errs -> hasError "invalid var binding name" errs `shouldBe` True@@ -103,7 +151,10 @@                   [ Dependency (ModuleName "mod-a") (Map.singleton (VarName "nix.system") "aarch64-darwin") Nothing                   ],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }       validateRecipe recipe `shouldBe` Right recipe @@ -115,7 +166,10 @@                 description = Nothing,                 modules = [],                 vars = [],-                prompts = []+                prompts = [],+                extends = Nothing,+                moduleOverrides = [],+                promptOverrides = []               }       case validateRecipe recipe of         Left errs -> length errs `shouldSatisfy` (>= 2)@@ -139,6 +193,9 @@               [simpleDep "unavailable"]               [requiredVar "enabled", requiredVar "enabled"]               [Prompt "missing-target" "Question" (Just (ExprAnd (ExprIsSet "unknown-a") (ExprNot (ExprOr (ExprLit True) (ExprEq "unknown-b" (VBool False)))))) Nothing]+              Nothing+              []+              []       case validateRecipe recipe of         Left errs -> do           length errs `shouldBe` 4@@ -159,3 +216,6 @@     [Dependency "unavailable" (Map.singleton "member.only" "literal ${unchanged}") Nothing]     [requiredVar "enabled", requiredVar "owner"]     [Prompt "owner" "Owner?" (Just (ExprAnd (ExprEq "enabled" (VBool True)) (ExprNot (ExprOr (ExprIsSet "owner") (ExprLit False))))) Nothing]+    Nothing+    []+    []

@@ -43,6 +43,7 @@           Map.empty           []           Nothing+          Nothing           now       exact = first & #ownership .~ claims a ["demo", "second"]       known = emptyManifest now & #applications .~ map application [a, b] & #seeds .~ Map.singleton "CHANGELOG.md" exact

@@ -394,6 +394,22 @@               Left (DhallEvalError _ message) -> message `shouldSatisfy` T.isInfixOf context               other -> expectationFailure ("Expected controlled decode failure, got: " <> show other) +    it "decodes a settings-only derived descriptor and rejects malformed override conditions" $ do+      withSystemTempDirectory "recipe-extension-decoding" $ \tmpDir -> do+        let descriptor condition = "{ name = \"child\", version = None Text, description = None Text, modules = [] : List Text, vars = [] : List {name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text}, prompts = [] : List {var : Text, text : Text, when : Optional Text, choices : Optional (List Text)}, extends = Some {recipe = \"base\"}, moduleOverrides = [{module = \"one\", vars = [{name = \"x\", value = \"new\"}]}], promptOverrides = [{var = \"x\", text = \"New?\", when = " <> condition <> ", choices = None (List Text)}]}"+        writeFile (tmpDir </> "recipe.dhall") (descriptor "None Text")+        result <- evalRecipeFromFile (tmpDir </> "recipe.dhall")+        case result of+          Left err -> expectationFailure (show err)+          Right recipe -> do+            recipe ^. #extends `shouldBe` Just (RecipeReference "base" Nothing Nothing)+            recipe ^. #moduleOverrides `shouldBe` [RecipeModuleOverride "one" (Map.singleton "x" "new")]+        writeFile (tmpDir </> "recipe.dhall") (descriptor "Some \"Eq x\"")+        bad <- evalRecipeFromFile (tmpDir </> "recipe.dhall")+        case bad of+          Left _ -> pure ()+          Right _ -> expectationFailure "Malformed override condition escaped the loader"+     it "decodes the haskell-with-nix-recipe fixture" $ do       result <- evalRecipeFromFile (fixtureDir </> "haskell-with-nix-recipe" </> "recipe.dhall")       case result of

@@ -37,7 +37,7 @@ fixtureManifest = emptyManifest now & #applications .~ [app] & #checkoutOutputs .~ Map.fromList [(dest, record source) | (dest, source) <- [(".local/config", "config/editor"), (".tool/assets", "assets/shared")]]   where     now = UTCTime (fromGregorian 2026 10 15) 0-    app = AppliedComposition (ApplicationId "a") (AppliedModuleTarget "demo") (LocalOrigin "demo") (Just "1") [] Nothing Nothing [AppliedInstanceState "demo" emptyParentVars (LocalOrigin "demo") (Just "1") Map.empty] Map.empty [] Nothing now+    app = AppliedComposition (ApplicationId "a") (AppliedModuleTarget "demo") (LocalOrigin "demo") (Just "1") [] Nothing Nothing [AppliedInstanceState "demo" emptyParentVars (LocalOrigin "demo") (Just "1") Map.empty] Map.empty [] Nothing Nothing now     record source = CheckoutOutputRecord (DirectorySymlink source) (Map.singleton (ApplicationId "a") (Set.singleton "demo"))  withFixture :: (FilePath -> IO a) -> IO a

@@ -81,7 +81,7 @@ spec = do   describe "seed preservation and exact selection" $ do     let appId = ApplicationId "a"-        app = AppliedComposition appId (AppliedModuleTarget modName) (LocalOrigin "test-module") Nothing [] Nothing Nothing [AppliedInstanceState name emptyParentVars (LocalOrigin text) Nothing Map.empty | (name, text) <- [(modName, "test-module"), (otherMod, "other-module")]] Map.empty [] Nothing fixedTime+        app = AppliedComposition appId (AppliedModuleTarget modName) (LocalOrigin "test-module") Nothing [] Nothing Nothing [AppliedInstanceState name emptyParentVars (LocalOrigin text) Nothing Map.empty | (name, text) <- [(modName, "test-module"), (otherMod, "other-module")]] Map.empty [] Nothing Nothing fixedTime         receipt = SeedRecord modName (KnownSeedOwners (Map.singleton appId (Set.fromList [modName, otherMod]))) SeedCreated fixedTime         manifest = mkManifest False [] & #applications .~ [app] & #seeds .~ Map.singleton "seed.txt" receipt     it "retires a no-spec instance without losing a co-seeder or original supplier" $ do

@@ -29,7 +29,7 @@ tests = testSpec "seed update transactions" $ do   let now = UTCTime (fromGregorian 2026 10 26) 0       appId = ApplicationId "app"-      app = AppliedComposition appId (AppliedModuleTarget "seeder") (LocalOrigin "seeder") Nothing [] Nothing Nothing [AppliedInstanceState "seeder" emptyParentVars (LocalOrigin "seeder") Nothing Map.empty] Map.empty [] Nothing now+      app = AppliedComposition appId (AppliedModuleTarget "seeder") (LocalOrigin "seeder") Nothing [] Nothing Nothing [AppliedInstanceState "seeder" emptyParentVars (LocalOrigin "seeder") Nothing Map.empty] Map.empty [] Nothing Nothing now       manifest = emptyManifest now & #applications .~ [app]       claims = Map.singleton appId (Set.singleton "seeder")       createAction = SeedAction "seed.txt" "seeder" claims SeedWrite (Just "seed bytes\n")

@@ -8,7 +8,7 @@ import Data.Text qualified as T import Effectful import Seihou.Composition.Instance (primaryInstance)-import Seihou.Composition.Resolve (PromptPermission (..), RecipeInputSpec (..), resolveRecipeWithPrompts, resolveWithPromptPermission, resolveWithPrompts)+import Seihou.Composition.Resolve (PromptPermission (..), RecipeInputSpec (..), resolveRecipeWithPrompts, resolveRecipeWithSources, resolveWithPromptPermission, resolveWithPrompts) import Seihou.Core.Types import Seihou.Effect.ConsolePure import Seihou.Interaction.Prompt (promptForVar, runPrompts)@@ -103,6 +103,20 @@         resolve permission spec saved cli literals local =           resolveRecipeWithPrompts permission False spec modules saved cli literals Map.empty "" "" local Map.empty Map.empty Map.empty         recipe = RecipeInputSpec [feature] [mkPrompt "feature" "Feature?"] Nothing+    it "preserves declaring-recipe provenance for declared and undeclared literals in every consumer" $ do+      let origin = RemoteOrigin "https://example.com/policy.git" "child" Nothing+          source = FromRecipeBindingAt "child" origin+          literals = Map.singleton "feature" ("false", source)+      forM_ [recipe, RecipeInputSpec [] [] Nothing] $ \inputSpec -> do+        let (result, _) =+              runPureEff $+                runConsolePureNonInteractive $+                  resolveRecipeWithSources PromptsForbidden False inputSpec modules Map.empty Map.empty literals Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+        case result of+          Left errs -> expectationFailure (show errs)+          Right (_, values) -> do+            (values Map.! primaryInstance "consumer" Map.! "feature") ^. #value `shouldBe` VBool False+            (values Map.! primaryInstance "consumer" Map.! "feature") ^. #source `shouldBe` source     it "requires the recipe choice before considering a consumer default" $ do       let (result, _) = runPureEff $ runConsolePureNonInteractive $ resolve PromptsForbidden recipe Map.empty Map.empty Map.empty Map.empty       result `shouldBe` Left [MissingRequiredVar "feature"]

@@ -109,7 +109,8 @@                commandReceipts = Map.empty,                checkoutCommands = [],                recipeInputs = Nothing,-               appliedAt = fixedTime+               appliedAt = fixedTime,+               recipeChain = Nothing              }          ] @@ -197,7 +198,8 @@       commandReceipts = receipts,       checkoutCommands = [],       recipeInputs = composition ^. #recipeInputs,-      appliedAt = composition ^. #appliedAt+      appliedAt = composition ^. #appliedAt,+      recipeChain = composition ^. #recipeChain     }  -- | Every string in a document, each paired with the JSON path that reaches@@ -232,6 +234,23 @@  spec :: Spec spec = do+  describe "recipe inheritance provenance" $ do+    let origin = RemoteOrigin "https://example.com/recipes.git" "child" Nothing+        base = AppliedRecipeNode "base" (ProjectOrigin ".seihou/modules/base") (Just "1") (hashContent "base")+        child = AppliedRecipeNode "child" origin (Just "1") (hashContent "child")+        app = AppliedComposition (ApplicationId "recipe-app") (AppliedRecipeTarget "child") origin (Just "1") [] Nothing Nothing [] Map.empty [] Nothing (Just [base, child]) fixedTime+        manifest = emptyManifest fixedTime & #applications .~ [app]+    it "roundtrips portable ordered nodes without cache paths" $ do+      manifestFromJSON (manifestToJSON manifest) `shouldBe` Right manifest+      LBS8.unpack (manifestToJSON manifest) `shouldSatisfy` (not . isInfixOf "/Users/")+    it "rejects loss at older schemas, a mismatched target, and absolute project origins" $ do+      manifestEncodingLoss (manifest & #version .~ ManifestSchemaVersion 12) `shouldSatisfy` (not . null)+      manifestEncodingLoss (manifest & #applications .~ [app & #recipeChain .~ Just [base]]) `shouldSatisfy` (not . null)+      manifestEncodingLoss (manifest & #applications .~ [app & #recipeChain .~ Just [base & #origin .~ ProjectOrigin "/tmp/private", child]]) `shouldSatisfy` (not . null)+    it "decodes older recipe applications with unknown chain history" $ do+      let old = manifest & #version .~ ManifestSchemaVersion 12 & #applications .~ [app & #recipeChain .~ Nothing]+      fmap (map (^. #recipeChain) . (^. #applications)) (manifestFromJSON (manifestToJSON old)) `shouldBe` Right [Nothing]+   describe "recipe inputs" $ do     forM_ [Nothing, Just Map.empty, Just (Map.singleton "feature" "false")] $ \inputs ->       it ("roundtrips unknown, empty and false recipe state: " <> show inputs) $ do@@ -278,7 +297,7 @@    describe "checkout command codec" $ do     let command = CheckoutCommand "demo" 0 "mkdir -p .local/setup" Nothing-        application commands = AppliedComposition (ApplicationId "setup") (AppliedModuleTarget "demo") (ProjectOrigin "modules/demo") (Just "1") [] Nothing Nothing [AppliedInstanceState "demo" emptyParentVars (ProjectOrigin "modules/demo") (Just "1") Map.empty] Map.empty commands Nothing fixedTime+        application commands = AppliedComposition (ApplicationId "setup") (AppliedModuleTarget "demo") (ProjectOrigin "modules/demo") (Just "1") [] Nothing Nothing [AppliedInstanceState "demo" emptyParentVars (ProjectOrigin "modules/demo") (Just "1") Map.empty] Map.empty commands Nothing Nothing fixedTime         manifest commands = emptyManifest fixedTime & #applications .~ [application commands]         mutateApp transform value = case value of           Aeson.Object fields -> case KeyMap.lookup "applications" fields of@@ -530,7 +549,8 @@                 commandReceipts = Map.singleton fingerprint receipt,                 checkoutCommands = [],                 recipeInputs = Nothing,-                appliedAt = fixedTime+                appliedAt = fixedTime,+                recipeChain = Nothing               }           application2 =             AppliedComposition@@ -545,7 +565,8 @@                 commandReceipts = Map.empty,                 checkoutCommands = [],                 recipeInputs = Nothing,-                appliedAt = fixedTime2+                appliedAt = fixedTime2,+                recipeChain = Nothing               }           fileRecord =             FileRecord@@ -716,7 +737,8 @@                 commandReceipts = Map.empty,                 checkoutCommands = [],                 recipeInputs = Nothing,-                appliedAt = fixedTime+                appliedAt = fixedTime,+                recipeChain = Nothing               }           fileRecord = FileRecord (SHA256 "hash") "base" Template fixedTime Nothing mempty SharedWriteUnknown           recipe = AppliedRecipe "recipe" (LocalOrigin "recipe") (Just "1.0.0") fixedTime

@@ -63,6 +63,16 @@  spec :: Spec spec = do+  it "upgrades schema 12 with unknown recipe chain history and preserves unknown raw fields" $ do+    let document = Aeson.object ["version" Aeson..= (12 :: Int), "futureTop" Aeson..= True, "applications" Aeson..= [Aeson.object ["producerOwned" Aeson..= True]]]+    case upgradeDocumentLosslessly (v 13) document of+      Left err -> expectationFailure (show err)+      Right (steps, Aeson.Object fields) -> do+        map (^. #action) steps `shouldBe` [AddUnknownRecipeChain]+        KeyMap.lookup "futureTop" fields `shouldBe` Just (Aeson.Bool True)+        KeyMap.lookup "applications" fields `shouldBe` Just (Aeson.toJSON [Aeson.object ["producerOwned" Aeson..= True, "recipeChain" Aeson..= Aeson.Null]])+      Right _ -> expectationFailure "expected manifest object"+   it "upgrades schema 11 with unknown recipe inputs without manufacturing answers" $ do     let document = Aeson.object ["version" Aeson..= (11 :: Int), "applications" Aeson..= [Aeson.object ["producerOwned" Aeson..= True]]]     case upgradeDocumentLosslessly (v 12) document of