namespace SomhairlesDream.Modeling open System open System.IO open System.Security.Cryptography open System.Text open System.Text.Json open System.Text.Json.Nodes open SomhairlesDream.Shared [] type BridgeRequest = { Step: DesignStep GlbPath: string RenderPath: string option ResultPath: string LogPath: string } [] type BridgeResult = { BlenderVersion: string ExportedAt: DateTimeOffset ObjectIds: string array VerifiedObjectIds: string array GlbBytes: int64 RenderPath: string option RenderedAt: DateTimeOffset option } type IArtifactBridge = abstract Export: request: BridgeRequest * heartbeat: (unit -> unit) -> Result [] type PipelineOptions = { ArtifactRoot: string Ids: RunIds Render: bool Bridge: IArtifactBridge Clock: unit -> DateTimeOffset OnEvent: RunEvent -> unit } module private ArtifactFiles = let runDirectory (root: string) (ids: RunIds) = Path.Combine(root, ids.ProjectId, ids.RunId) let toSystemPath (relativePath: string) = relativePath.Replace('/', Path.DirectorySeparatorChar) let sha256 path = use stream = File.OpenRead(path) use sha = SHA256.Create() sha.ComputeHash(stream) |> Convert.ToHexString |> fun value -> value.ToLowerInvariant() let byteCount path = FileInfo(path).Length module private ManifestJson = let private options () = let value = JsonSerializerOptions() value.WriteIndented <- true value let private stringArray (values: string array) = let result = JsonArray() for value in values do result.Add(JsonValue.Create(value)) result :> JsonNode let private change (value: ArtifactChange) = let json = JsonObject() json["objectId"] <- JsonValue.Create(value.ObjectId) json["kind"] <- JsonValue.Create(value.Kind) json["summary"] <- JsonValue.Create(value.Summary) json :> JsonNode let private changes (values: ArtifactChange array) = let result = JsonArray() for value in values do result.Add(change value) result :> JsonNode let private render (value: RenderArtifact) = let json = JsonObject() json["artifactPath"] <- JsonValue.Create(value.ArtifactPath) json["sha256"] <- JsonValue.Create(value.Sha256) json["bytes"] <- JsonValue.Create(value.Bytes) json["exportedAt"] <- JsonValue.Create(value.ExportedAt) json :> JsonNode let private step (value: StepArtifact) = let json = JsonObject() json["stepId"] <- JsonValue.Create(value.StepId) json["stepIndex"] <- JsonValue.Create(value.StepIndex) json["artifactPath"] <- JsonValue.Create(value.ArtifactPath) json["logPath"] <- JsonValue.Create(value.LogPath) json["sha256"] <- JsonValue.Create(value.Sha256) json["bytes"] <- JsonValue.Create(value.Bytes) json["exportedAt"] <- JsonValue.Create(value.ExportedAt) json["objectIds"] <- stringArray value.ObjectIds json["verifiedObjectIds"] <- stringArray value.VerifiedObjectIds json["changes"] <- changes value.Changes match value.Render with | Some renderValue -> json["render"] <- render renderValue | None -> () json :> JsonNode let serialize (manifest: ArtifactManifest) = let json = JsonObject() let steps = JsonArray() for value in manifest.Steps do steps.Add(step value) json["schemaVersion"] <- JsonValue.Create(manifest.SchemaVersion) json["projectId"] <- JsonValue.Create(manifest.ProjectId) json["runId"] <- JsonValue.Create(manifest.RunId) json["baseId"] <- JsonValue.Create(manifest.BaseId) json["targetId"] <- JsonValue.Create(manifest.TargetId) json["status"] <- JsonValue.Create(manifest.Status) json["startedAt"] <- JsonValue.Create(manifest.StartedAt) json["completedAt"] <- JsonValue.Create(manifest.CompletedAt) json["blenderVersion"] <- JsonValue.Create(manifest.BlenderVersion) json["steps"] <- steps json.ToJsonString(options()) module Pipeline = let private validateIds (ids: RunIds) = [| ids.ProjectId; ids.RunId; ids.BaseId; ids.TargetId |] |> Array.tryFind (Ids.validateResourceId >> Result.isError) |> function | Some invalid -> Error $"invalid resource id: {invalid}" | None -> Ok () let private appendEvent (log: StreamWriter) (onEvent: RunEvent -> unit) event = log.WriteLine(RunEvent.toJson event) log.Flush() log.BaseStream.Flush() onEvent event let private writeManifest path manifest = let temporaryPath = path + ".tmp" let bytes = Encoding.UTF8.GetBytes(ManifestJson.serialize manifest) use stream = new FileStream(temporaryPath, FileMode.CreateNew, FileAccess.Write, FileShare.None, 4096, FileOptions.WriteThrough) stream.Write(bytes, 0, bytes.Length) stream.Flush(true) File.Move(temporaryPath, path) let private verifyBridgeResult (step: DesignStep) (request: BridgeRequest) (result: BridgeResult) = if not (File.Exists(request.GlbPath)) || ArtifactFiles.byteCount request.GlbPath = 0L then Error $"bridge did not produce a non-empty GLB for {step.StepId}" elif result.GlbBytes <> ArtifactFiles.byteCount request.GlbPath then Error $"bridge GLB byte count did not match for {step.StepId}" elif result.ExportedAt.Offset <> TimeSpan.Zero then Error $"bridge export timestamp was not UTC for {step.StepId}" elif result.RenderedAt |> Option.exists (fun value -> value.Offset <> TimeSpan.Zero) then Error $"bridge render timestamp was not UTC for {step.StepId}" elif request.RenderPath.IsSome <> result.RenderPath.IsSome then Error $"bridge render result did not match the request for {step.StepId}" elif request.RenderPath.IsSome && request.RenderPath <> result.RenderPath then Error $"bridge render path did not match the request for {step.StepId}" elif result.ObjectIds <> step.ObjectIds || result.VerifiedObjectIds <> step.ObjectIds then Error $"object ids did not match expected values for {step.StepId}" elif result.ObjectIds |> Array.exists (Ids.validateObjectId >> Result.isError) then Error $"bridge returned an invalid object id for {step.StepId}" else Ok () let private renderArtifact runDirectory (step: DesignStep) path renderedAt = if not (File.Exists(path)) || ArtifactFiles.byteCount path = 0L then Error $"bridge did not produce a non-empty render for {step.StepId}" else let relativePath = $"steps/{step.StepId}.png" let destination = Path.Combine(runDirectory, ArtifactFiles.toSystemPath relativePath) File.Move(path, destination) Ok { ArtifactPath = relativePath Sha256 = ArtifactFiles.sha256 destination Bytes = ArtifactFiles.byteCount destination ExportedAt = renderedAt } let run (options: PipelineOptions) = match validateIds options.Ids with | Error message -> Error message | Ok () -> let runDirectory = ArtifactFiles.runDirectory options.ArtifactRoot options.Ids if Directory.Exists(runDirectory) then Error "run directory already exists" else let stepsDirectory = Path.Combine(runDirectory, "steps") let logsDirectory = Path.Combine(runDirectory, "logs") let stagingDirectory = Path.Combine(runDirectory, ".staging") let eventsPath = Path.Combine(runDirectory, "events.ndjson") let manifestPath = Path.Combine(runDirectory, "manifest.json") let startedAt = options.Clock() let mutable currentStep: string option = None let mutable eventLog: StreamWriter option = None let mutable blenderVersion: string option = None try Directory.CreateDirectory(runDirectory) |> ignore Directory.CreateDirectory(stepsDirectory) |> ignore Directory.CreateDirectory(logsDirectory) |> ignore Directory.CreateDirectory(stagingDirectory) |> ignore use log = new StreamWriter(File.Open(eventsPath, FileMode.CreateNew, FileAccess.Write, FileShare.Read), UTF8Encoding(false)) eventLog <- Some log let emit event = appendEvent log options.OnEvent event let ids = options.Ids emit (RunEvent.Start { Ids = ids; At = startedAt; TotalSteps = Design.steps.Length }) let artifacts = [| for step in Design.steps do currentStep <- Some step.StepId emit (RunEvent.Heartbeat { Ids = ids; At = options.Clock(); Message = $"starting {step.StepId}" }) let glbStagingPath = Path.GetFullPath(Path.Combine(stagingDirectory, $"{step.StepId}.glb")) let renderStagingPath = Path.GetFullPath(Path.Combine(stagingDirectory, $"{step.StepId}.png")) let resultStagingPath = Path.GetFullPath(Path.Combine(stagingDirectory, $"{step.StepId}.result.json")) let logPath = Path.GetFullPath(Path.Combine(logsDirectory, $"{step.StepId}.log")) let request = { Step = step GlbPath = glbStagingPath RenderPath = if options.Render then Some renderStagingPath else None ResultPath = resultStagingPath LogPath = logPath } let bridgeResult = match options.Bridge.Export(request, fun () -> emit (RunEvent.Heartbeat { Ids = ids; At = options.Clock(); Message = $"heartbeat {step.StepId}" })) with | Ok value -> value | Error message -> failwith message blenderVersion <- Some bridgeResult.BlenderVersion match verifyBridgeResult step request bridgeResult with | Ok () -> () | Error message -> failwith message let relativePath = $"steps/{step.StepId}.glb" let destination = Path.Combine(runDirectory, ArtifactFiles.toSystemPath relativePath) File.Move(glbStagingPath, destination) let render = if options.Render then let renderedAt = bridgeResult.RenderedAt |> Option.defaultValue bridgeResult.ExportedAt match renderArtifact runDirectory step renderStagingPath renderedAt with | Ok value -> Some value | Error message -> failwith message else None let artifact = { StepId = step.StepId StepIndex = step.Index ArtifactPath = relativePath LogPath = $"logs/{step.StepId}.log" Sha256 = ArtifactFiles.sha256 destination Bytes = ArtifactFiles.byteCount destination ExportedAt = bridgeResult.ExportedAt ObjectIds = step.ObjectIds VerifiedObjectIds = bridgeResult.VerifiedObjectIds Changes = step.Changes Render = render } let checkpoint = { Ids = ids At = options.Clock() StepId = step.StepId StepIndex = step.Index TotalSteps = Design.steps.Length Message = "artifact verified" ArtifactPath = relativePath } emit (RunEvent.Checkpoint checkpoint) yield artifact |] let completedAt = options.Clock() let manifest = { SchemaVersion = 1 ProjectId = ids.ProjectId RunId = ids.RunId BaseId = ids.BaseId TargetId = ids.TargetId Status = "complete" StartedAt = startedAt CompletedAt = completedAt BlenderVersion = blenderVersion |> Option.defaultValue "unknown" Steps = artifacts } writeManifest manifestPath manifest emit (RunEvent.Complete { Ids = ids; At = completedAt; ManifestPath = "manifest.json" }) currentStep <- None if Directory.Exists(stagingDirectory) then Directory.Delete(stagingDirectory, true) Ok manifest with ex -> match eventLog with | Some log -> try appendEvent log options.OnEvent (RunEvent.Fail { Ids = options.Ids; At = options.Clock(); StepId = currentStep; Message = ex.Message }) with _ -> () | None -> () if Directory.Exists(stagingDirectory) then Directory.Delete(stagingDirectory, true) Error ex.Message module ArtifactVerifier = let private stringProperty (value: JsonElement) (name: string) = let result = value.GetProperty(name).GetString() if isNull result then failwith $"manifest property '{name}' is null" else result let private parseRender (value: JsonElement) = let mutable renderValue = Unchecked.defaultof if value.TryGetProperty("render", &renderValue) then Some { ArtifactPath = stringProperty renderValue "artifactPath" Sha256 = stringProperty renderValue "sha256" Bytes = renderValue.GetProperty("bytes").GetInt64() ExportedAt = renderValue.GetProperty("exportedAt").GetDateTimeOffset() } else None let private parseStep (value: JsonElement) : StepArtifact = { StepId = stringProperty value "stepId" StepIndex = value.GetProperty("stepIndex").GetInt32() ArtifactPath = stringProperty value "artifactPath" LogPath = stringProperty value "logPath" Sha256 = stringProperty value "sha256" Bytes = value.GetProperty("bytes").GetInt64() ExportedAt = value.GetProperty("exportedAt").GetDateTimeOffset() ObjectIds = value.GetProperty("objectIds").EnumerateArray() |> Seq.map (fun item -> item.GetString()) |> Seq.toArray VerifiedObjectIds = value.GetProperty("verifiedObjectIds").EnumerateArray() |> Seq.map (fun item -> item.GetString()) |> Seq.toArray Changes = value.GetProperty("changes").EnumerateArray() |> Seq.map (fun item -> { ObjectId = stringProperty item "objectId" Kind = stringProperty item "kind" Summary = stringProperty item "summary" }) |> Seq.toArray Render = parseRender value } let private parseManifest (value: JsonElement) : ArtifactManifest = { SchemaVersion = value.GetProperty("schemaVersion").GetInt32() ProjectId = stringProperty value "projectId" RunId = stringProperty value "runId" BaseId = stringProperty value "baseId" TargetId = stringProperty value "targetId" Status = stringProperty value "status" StartedAt = value.GetProperty("startedAt").GetDateTimeOffset() CompletedAt = value.GetProperty("completedAt").GetDateTimeOffset() BlenderVersion = stringProperty value "blenderVersion" Steps = value.GetProperty("steps").EnumerateArray() |> Seq.map parseStep |> Seq.toArray } let private safePath runDirectory relativePath = if String.IsNullOrWhiteSpace(relativePath) || Path.IsPathRooted(relativePath) then Error "artifact path must be relative" else let normalized = relativePath.Replace('\\', '/') let segments = normalized.Split('/', StringSplitOptions.RemoveEmptyEntries) if segments |> Array.exists (fun segment -> segment = ".." || segment = ".") then Error "artifact path contains traversal" else let fullPath = Path.GetFullPath(Path.Combine(runDirectory, ArtifactFiles.toSystemPath normalized)) let prefix = Path.GetFullPath(runDirectory).TrimEnd(Path.DirectorySeparatorChar) + string Path.DirectorySeparatorChar if fullPath.StartsWith(prefix, StringComparison.Ordinal) then Ok fullPath else Error "artifact path escapes run directory" let private verifyFile runDirectory expectedPath expectedHash expectedBytes = match safePath runDirectory expectedPath with | Error message -> Error message | Ok path when not (File.Exists(path)) -> Error $"artifact is missing: {expectedPath}" | Ok path when FileInfo(path).Length <> expectedBytes -> Error $"artifact byte count mismatch: {expectedPath}" | Ok path when ArtifactFiles.sha256 path <> expectedHash -> Error $"artifact hash mismatch: {expectedPath}" | Ok _ -> Ok () let private verifyLogFile runDirectory expectedPath = match safePath runDirectory expectedPath with | Error message -> Error message | Ok path when not (File.Exists(path)) -> Error $"log is missing: {expectedPath}" | Ok path when FileInfo(path).Length = 0L -> Error $"log is empty: {expectedPath}" | Ok _ -> Ok () let verify manifestPath = try if not (File.Exists(manifestPath)) then Error "manifest is missing" elif Path.GetFileName(manifestPath) <> "manifest.json" then Error "manifest path must be manifest.json" else use document = JsonDocument.Parse(File.ReadAllText(manifestPath)) let manifest = parseManifest document.RootElement let runDirectory = Path.GetDirectoryName(Path.GetFullPath(manifestPath)) let projectDirectory = Directory.GetParent(runDirectory).Name let runDirectoryName = DirectoryInfo(runDirectory).Name if manifest.SchemaVersion <> 1 then Error "unsupported manifest schema" elif manifest.Status <> "complete" then Error "manifest is not complete" elif manifest.ProjectId <> projectDirectory || manifest.RunId <> runDirectoryName then Error "manifest identity does not match its directory" elif Ids.validateResourceId manifest.ProjectId |> Result.isError || Ids.validateResourceId manifest.RunId |> Result.isError || Ids.validateResourceId manifest.BaseId |> Result.isError || Ids.validateResourceId manifest.TargetId |> Result.isError then Error "manifest contains an invalid resource id" elif manifest.Steps.Length <> Design.steps.Length then Error "manifest step count does not match design" else let mutable failure: string option = None for expected, actual in Array.zip Design.steps manifest.Steps do if failure.IsNone && actual.StepId <> expected.StepId then failure <- Some $"manifest step id mismatch: {expected.StepId}" elif failure.IsNone && actual.StepIndex <> expected.Index then failure <- Some $"manifest step index mismatch: {expected.StepId}" elif failure.IsNone && actual.ObjectIds <> expected.ObjectIds then failure <- Some $"manifest source object ids mismatch: {expected.StepId}" elif failure.IsNone && actual.VerifiedObjectIds <> expected.ObjectIds then failure <- Some $"manifest verified object ids mismatch: {expected.StepId}" elif failure.IsNone && actual.Changes <> expected.Changes then failure <- Some $"manifest changes mismatch: {expected.StepId}" elif failure.IsNone then let expectedPath = $"steps/{expected.StepId}.glb" let expectedLogPath = $"logs/{expected.StepId}.log" if actual.ArtifactPath <> expectedPath then failure <- Some $"manifest artifact path mismatch: {expected.StepId}" elif actual.LogPath <> expectedLogPath then failure <- Some $"manifest log path mismatch: {expected.StepId}" else match verifyLogFile runDirectory actual.LogPath with | Error message -> failure <- Some message | Ok () -> match verifyFile runDirectory actual.ArtifactPath actual.Sha256 actual.Bytes with | Error message -> failure <- Some message | Ok () -> match actual.Render with | Some render -> match verifyFile runDirectory render.ArtifactPath render.Sha256 render.Bytes with | Error message -> failure <- Some message | Ok () -> () | None -> () match failure with | Some message -> Error message | None -> Ok manifest with ex -> Error $"invalid manifest: {ex.Message}"