1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
namespace SomhairlesDream.Server
open System
open System.IO
open System.Text.Json
open System.Threading.Tasks
open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.Http
open SomhairlesDream.Shared
[<CLIMutable>]
type RunStartRequest =
{ ProjectId: string
RunId: string
BaseId: string
TargetId: string
Render: bool }
type ArtifactRunApiOptions =
{ Coordinator: ArtifactRunCoordinator
Clock: unit -> DateTimeOffset
JsonOptions: JsonSerializerOptions }
module ArtifactRunApi =
let private json options value = Results.Json(value, options.JsonOptions)
let private jsonWithStatus options statusCode value =
Results.Json(value, options.JsonOptions, statusCode = Nullable<int>(statusCode))
let private error options statusCode message =
jsonWithStatus options statusCode {| error = message |}
let private readStartRequest options (request: HttpRequest) =
task {
try
let! value = request.ReadFromJsonAsync<RunStartRequest>(options.JsonOptions)
if isNull (box value) then
return Error "request body must be a JSON object"
else
return Ok value
with
| :? JsonException as ex -> return Error $"invalid JSON: {ex.Message}"
}
let private start options (context: HttpContext) : Task<IResult> =
task {
let! request = readStartRequest options context.Request
match request with
| Error message -> return error options 400 message
| Ok request ->
let ids : RunIds =
{ ProjectId = request.ProjectId
RunId = request.RunId
BaseId = request.BaseId
TargetId = request.TargetId }
match options.Coordinator.Start(ids, request.Render) with
| Ok(Accepted snapshot) -> return jsonWithStatus options 202 snapshot
| Ok(Conflict snapshot) -> return jsonWithStatus options 409 snapshot
| Error message when message = "run registry entry disappeared" ->
return error options 500 message
| Error message -> return error options 400 message
}
let private queryValue (context: HttpContext) name =
let value = context.Request.Query[name].ToString()
if String.IsNullOrWhiteSpace(value) then
None
else
Some value
let private selector context =
match queryValue context "projectId", queryValue context "runId" with
| Some projectId, Some runId ->
match Ids.validateResourceId projectId, Ids.validateResourceId runId with
| Error message, _ -> Error $"invalid projectId: {message}"
| _, Error message -> Error $"invalid runId: {message}"
| Ok (), Ok () -> Ok(projectId, runId)
| None, _ -> Error "missing query parameter 'projectId'"
| _, None -> Error "missing query parameter 'runId'"
let private manifest options (context: HttpContext) =
match selector context with
| Error message -> error options 400 message
| Ok(projectId, runId) ->
match options.Coordinator.Manifest(projectId, runId) with
| Ok value -> json options value
| Error RunNotFound -> error options 404 "run not found"
| Error(RunNotComplete snapshot) -> jsonWithStatus options 409 snapshot
| Error(InvalidManifest message) -> error options 500 message
| Error(InvalidArtifactPath message) -> error options 500 message
| Error ArtifactNotFound -> error options 500 "manifest not found"
let private artifactContentType (path: string) =
match Path.GetExtension(path).ToLowerInvariant() with
| ".glb" -> "model/gltf-binary"
| ".json" -> "application/json"
| ".png" -> "image/png"
| ".log" -> "text/plain"
| _ -> "application/octet-stream"
let private artifact options (context: HttpContext) =
match selector context, queryValue context "path" with
| Error message, _ -> error options 400 message
| _, None -> error options 400 "missing query parameter 'path'"
| Ok(projectId, runId), Some relativePath ->
match options.Coordinator.Artifact(projectId, runId, relativePath) with
| Ok path -> Results.File(path, artifactContentType path)
| Error RunNotFound -> error options 404 "run not found"
| Error(RunNotComplete snapshot) -> jsonWithStatus options 409 snapshot
| Error(InvalidArtifactPath message) -> error options 400 message
| Error ArtifactNotFound -> error options 404 "artifact not found"
| Error(InvalidManifest message) -> error options 500 message
let private stepArtifact options (context: HttpContext) =
match selector context, queryValue context "path" with
| Error message, _ -> error options 400 message
| _, None -> error options 400 "missing query parameter 'path'"
| Ok(projectId, runId), Some relativePath ->
match options.Coordinator.StepArtifact(projectId, runId, relativePath) with
| Ok path -> Results.File(path, artifactContentType path)
| Error RunNotFound -> error options 404 "run not found"
| Error(RunNotComplete snapshot) -> jsonWithStatus options 409 snapshot
| Error(InvalidArtifactPath message) -> error options 400 message
| Error ArtifactNotFound -> error options 404 "artifact not found"
| Error(InvalidManifest message) -> error options 500 message
let private writeError options (context: HttpContext) statusCode message =
task {
context.Response.StatusCode <- statusCode
context.Response.ContentType <- "application/json"
let payload = JsonSerializer.Serialize({| error = message |}, options.JsonOptions)
do! context.Response.WriteAsync(payload)
}
let private events options (context: HttpContext) : Task =
task {
match selector context with
| Error message -> do! writeError options context 400 message
| Ok(projectId, runId) ->
match options.Coordinator.Subscribe(projectId, runId) with
| None -> do! writeError options context 404 "run not found"
| Some subscription ->
use _lifetime = subscription :> IDisposable
context.Response.StatusCode <- 200
context.Response.ContentType <- "text/event-stream"
context.Response.Headers.CacheControl <- "no-cache"
context.Response.Headers["X-Accel-Buffering"] <- "no"
try
while not context.RequestAborted.IsCancellationRequested do
let! snapshot = subscription.Reader.ReadAsync(context.RequestAborted).AsTask()
let payload = JsonSerializer.Serialize(snapshot, options.JsonOptions)
do! context.Response.WriteAsync($"data: {payload}\n\n", context.RequestAborted)
do! context.Response.Body.FlushAsync(context.RequestAborted)
with
| :? OperationCanceledException -> ()
}
let register (app: WebApplication) options =
app.MapPost("/api/runs/start", Func<HttpContext, Task<IResult>>(fun context -> start options context))
|> ignore
app.MapGet("/api/runs/events", Func<HttpContext, Task>(fun context -> events options context))
|> ignore
app.MapGet("/api/artifacts/manifest", Func<HttpContext, IResult>(fun context -> manifest options context))
|> ignore
app.MapGet("/api/artifacts/file", Func<HttpContext, IResult>(fun context -> artifact options context))
|> ignore
app.MapGet("/api/artifacts/steps", Func<HttpContext, IResult>(fun context -> stepArtifact options context))
|> ignore
|
