diff --git a/docs/spec/canvas-pane.md b/docs/spec/canvas-pane.md index 252bff99..8db09412 100644 --- a/docs/spec/canvas-pane.md +++ b/docs/spec/canvas-pane.md @@ -87,7 +87,7 @@ A `SystemView` drives its own updates, so it needs neither morph nor the author - Selecting a tab marks that doc viewed. - Viewed but inactive tabs render at 0.5 opacity. The active tab stays full opacity. - The archive button moves the active doc to `.agents/canvas/archive/`. It is shown only when the active doc is an `AgentDoc` — a `SystemView` is server-regenerated, not user-owned, so it has no archive button. -- The share button publishes the active doc to an unguessable, auto-expiring URL and copies a rich titled link to the clipboard. Like archive, it is shown only when the active doc is an `AgentDoc` — a `SystemView` is server-generated, not shareable, so it has no share button. Clipboard success uses the shared, dismissible `ClipboardNotice` channel (green), independent of the send `Waiting` and delivery-`Failed` banners: a successful publish shows `Shared — link copied` (or `Shared — link ready, copy it manually: ` when the async clipboard write is rejected), while a *failed* publish reuses the existing red `CanvasSendState.Failed` error banner. Success and failure are mutually exclusive — each result arm clears the other channel — so a red + green stack never renders. Share cannot start while a path copy is pending, and path copy cannot start until Share has completed its publish and clipboard phases. See `docs/spec/canvas-sharing.md` for the full publish/SAS/clipboard flow. +- The share button publishes the active doc to an unguessable, auto-expiring authenticated-viewer URL and copies a rich titled link to the clipboard. Like archive, it is shown only when the active doc is an `AgentDoc` — a `SystemView` is server-generated, not shareable, so it has no share button. Clipboard success uses the dismissible `ClipboardNotice` channel (green), independent of the send `Waiting` and delivery-`Failed` banners: a successful publish shows `Shared — link copied` (or `Shared — link ready, copy it manually: ` when the async clipboard write is rejected), while a *failed* publish reuses the existing red `CanvasSendState.Failed` error banner. Success and failure are mutually exclusive — each result arm clears the other channel — so a red + green stack never renders. Share cannot start while a path copy is pending, and path copy cannot start until Share has completed its publish and clipboard phases. See `docs/spec/canvas-sharing.md` for the full publish/viewer/clipboard flow. ### Canvas Overview @@ -335,7 +335,7 @@ changed rows already use). - `docs/spec/worktree-monitor.md` — parent dashboard architecture spec - `docs/spec/beadspace-canvas.md` — beads dashboard integration in the canvas pane -- `docs/spec/canvas-sharing.md` — one-click Share of a focused `AgentDoc` to an unguessable, auto-expiring URL (the tab-bar Share button, its publish/SAS backend, and the clipboard rich link) +- `docs/spec/canvas-sharing.md` — one-click Share of a focused `AgentDoc` to an unguessable, auto-expiring authenticated-viewer URL (the tab-bar Share button, private-Blob publisher, and clipboard rich link) - `docs/spec/canvas-interaction-routing.md` — ownership, generated-view affinity, queueing, and session routing - `docs/spec/worktree-diff-viewer.md` — generated worktree diff SystemView - `docs/spec/future/canvas-roadmap.md` — remaining canvas work (authoring DX, templates) diff --git a/docs/spec/canvas-sharing.md b/docs/spec/canvas-sharing.md index dc71d394..d643a218 100644 --- a/docs/spec/canvas-sharing.md +++ b/docs/spec/canvas-sharing.md @@ -2,418 +2,380 @@ ## Goals -- One-click **Share** of a focused canvas doc to an **unguessable URL** any recipient can open in a - plain browser — **no login** — that renders the doc's HTML+JS read-only with agent-interactivity - neutralized. -- **Recipient-only secrecy:** the link is a per-doc capability (a leaked link exposes only that one - doc) and **auto-expires** (7 days — Azure's maximum for a keyless user delegation SAS). -- **Hide the ugly URL:** copy a **rich titled hyperlink** to the clipboard so the raw URL length is - cosmetically irrelevant when pasted into chat/mail. +- One-click Share of a focused canvas doc to a clean, unguessable URL that a recipient opens in a + plain browser after signing in with Microsoft Entra. No SAS, account key, or other bearer + credential is ever generated or returned to the recipient. +- Real authorization, not just secrecy: the URL's opaque segment narrows which document a + signed-in identity can reach, but Entra sign-in is what actually gates access. A link leaked + outside the tenant is not sufficient to view the document; inside the tenant, the audience is + every authenticated member and B2B guest holding it. +- A bounded, view-time-enforced lifetime: a document stops being viewable at its configured expiry + even if the underlying blob has not yet been swept up by storage lifecycle cleanup. +- Contained interactivity: the recipient still sees the document's live HTML/JS rather than a + static/PDF downgrade, but that script runs in a sandbox that cannot reach the viewer's + authenticated origin, read its cookies, or exfiltrate over the network. +- A rich, titled hyperlink on the clipboard so paste targets (chat, mail, docs) show a meaningful + link regardless of the URL's actual length or shape. ## Expected Behavior ### Share action -- A **Share** button appears in the canvas tab bar next to Archive, for **`AgentDoc` docs only** - (a `SystemView` like the beads dashboard is server-generated and not shareable). -- Clicking it: static-exports the focused doc → uploads it to Azure Blob Storage → mints a per-doc - read-only SAS URL → writes a **rich link + plain URL** to the clipboard → shows a success banner - (`Shared — link copied`). On failure it shows the existing dismissible error banner. -- **The button shows progress and refuses re-entry while a share is in flight.** Publishing is a - multi-second round-trip (Entra token → user delegation key → upload → clipboard), so - `CanvasState.ShareState` records the scoped worktree/doc and the `Publishing` or - `WritingClipboard` phase. Every Share button is disabled while that state is non-idle, only the - matching scoped doc shows the spinner, and the reducer rejects another launch. Results transition - or clear only the matching operation, so navigation and stale async completions cannot unlock or - overwrite a newer share (locked by `ShareCanvasDocResultTests`). +- A Share button appears in the canvas tab bar next to Archive, for `AgentDoc` docs only (a + `SystemView` such as the beads dashboard is server-generated and not shareable). +- Clicking it static-exports the focused doc, uploads it to the private Blob container, records an + expiry, and returns a clean viewer URL; the client then writes the rich clipboard payload and + shows a success banner (`Shared -- link copied`). A failure at any stage reuses the existing + dismissible error banner. +- Before reading the source file or contacting Azure, the publisher requires a non-empty filename + segment with no path separator and an `.html` suffix matched case-insensitively. The original + filename casing is preserved for the exact Blob name and recipient URL; harmless consecutive + dots within the segment are accepted. +- The button shows progress and refuses re-entry while a share is in flight: `CanvasState.ShareState` + records the scoped worktree/doc and the `Publishing` or `WritingClipboard` phase, every Share + button is disabled while that state is non-idle, only the matching scoped doc shows the spinner, + and results only transition or clear the matching operation -- so navigation or a stale async + completion cannot unlock or overwrite a newer share (locked by `ShareCanvasDocResultTests`). - Share and canvas-path copy are mutually exclusive clipboard workflows. The reducer rejects either action while the other owns the clipboard, and both controls are disabled until that workflow settles, so their async results cannot overwrite the pane-global error or clipboard notice state. -- The action operates on a **single, self-contained doc**. Docs that link to sibling `.html` tabs - are shared as just the focused file; sibling links are inert in the export. Multi-doc bundles are - out of scope. - -### Static export (what gets published) - -The on-disk `.agents/canvas/.html` already contains **none** of the serve-time injected -scripts (bridge heartbeat, `canvasSend`, idiomorph/morph, error overlay) — those are added only by -`CanvasDocServer` at `:5002`. So the export does the **opposite of stripping**: it re-injects the -two pieces a standalone copy needs, and nothing else. - -- Inject the **base theme `" + ) + |> Encoding.UTF8.GetBytes + + let private writeShell + (context: HttpContext) + (_metadata: Map) + : Task = + task { + let content = shellBytes context + context.Response.ContentType <- "text/html; charset=utf-8" + context.Response.ContentLength <- content.LongLength + do! + context.Response.Body.WriteAsync( + content, + context.RequestAborted + ) + } + + let private writeContent + (context: HttpContext) + (document: BlobDocument) + : Task = + task { + use document = document + context.Response.ContentType <- "text/html; charset=utf-8" + context.Response.ContentLength <- document.ContentLength + do! + document.Content.CopyToAsync( + context.Response.Body, + context.RequestAborted + ) + } + + let private handle + resolve + contentSecurityPolicy + (render: HttpContext -> 'stored -> Task) + (context: HttpContext) + : Task = + task { + applyResponsePolicy contentSecurityPolicy context + + let prefix = routeSegment "prefix" context + let filename = routeSegment "filename" context + + let! result = + resolve + prefix + filename + context.RequestAborted + + match result with + | Available document -> + do! render context document + | NotFound -> + context.Response.StatusCode <- + StatusCodes.Status404NotFound + context.Response.ContentLength <- 0L + } + + let private serveShell reader clock = + handle + (ShareLookup.resolveProperties reader clock) + ShellContentSecurityPolicy + writeShell + + let private handleContent + reader + clock + (context: HttpContext) + = + if isSameOriginIframeNavigation context then + handle + (ShareLookup.resolveDocument reader clock) + ContentContentSecurityPolicy + writeContent + context + else + serveShell reader clock context + + let create + (builder: WebApplicationBuilder) + (reader: BlobReader) + clock + = + builder.WebHost.ConfigureKestrel(fun options -> + options.AddServerHeader <- false) + |> ignore + builder.Services.AddRouting() |> ignore + + let app = builder.Build() + app.Use(fun context next -> + handleDependencyFailures app.Logger context next) + |> ignore + app.UseRouting() |> ignore + + app.MapGet( + ContentRoute, + RequestDelegate( + handleContent + reader + clock + ) + ) + |> ignore + + app.MapGet( + ShellRoute, + RequestDelegate(serveShell reader clock) + ) + |> ignore + + app diff --git a/src/CanvasShareViewer/ViewerConfiguration.fs b/src/CanvasShareViewer/ViewerConfiguration.fs new file mode 100644 index 00000000..e09aaa51 --- /dev/null +++ b/src/CanvasShareViewer/ViewerConfiguration.fs @@ -0,0 +1,43 @@ +namespace CanvasShareViewer + +open System +open Microsoft.Extensions.Configuration + +type internal ViewerConfiguration = + { StorageAccountName: string + ShareContainer: string } + +module internal ViewerConfiguration = + + [] + let SectionName = "CanvasShareViewer" + + [] + let StorageAccountNameKey = "StorageAccountName" + + [] + let ShareContainerKey = "ShareContainer" + + let private requiredValue (section: IConfigurationSection) key = + section[key] + |> Option.ofObj + |> Option.map _.Trim() + |> Option.filter (not << String.IsNullOrWhiteSpace) + + let read (configuration: IConfiguration) = + let section = configuration.GetSection(SectionName) + + match + requiredValue section StorageAccountNameKey, + requiredValue section ShareContainerKey + with + | Some accountName, Some container -> + Ok + { StorageAccountName = accountName + ShareContainer = container } + | None, _ -> + Error + $"Missing required configuration '{SectionName}:{StorageAccountNameKey}'." + | _, None -> + Error + $"Missing required configuration '{SectionName}:{ShareContainerKey}'." diff --git a/src/CanvasShareViewer/appsettings.json b/src/CanvasShareViewer/appsettings.json new file mode 100644 index 00000000..de59c129 --- /dev/null +++ b/src/CanvasShareViewer/appsettings.json @@ -0,0 +1,6 @@ +{ + "CanvasShareViewer": { + "StorageAccountName": "", + "ShareContainer": "" + } +} diff --git a/src/Client/AppTypes.fs b/src/Client/AppTypes.fs index dc8c974e..1a962263 100644 --- a/src/Client/AppTypes.fs +++ b/src/Client/AppTypes.fs @@ -115,7 +115,7 @@ type Msg = | CopyCanvasDocPath of scopedKey: string * filename: string | CanvasDocPathCopyResult of scopedKey: string * filename: string * revision: int * path: string * Result | ClearCanvasDocPathCopied of scopedKey: string * filename: string * revision: int - // Share the focused AgentDoc: publish it (server mints a per-doc read-only SAS URL + returns the + // Share the focused AgentDoc: publish it (server returns a clean authenticated-viewer URL + the // doc title) then write a rich clipboard link. ShareCanvasDocResult carries the CanvasShareResult // on Ok (→ dual-format clipboard write, deferring the banner to ClipboardWriteResult) or an error // message on failure (→ the existing error banner). ClipboardWriteResult reports whether the async diff --git a/src/Client/CanvasUpdate.fs b/src/Client/CanvasUpdate.fs index 82ec9d2d..42a2d24a 100644 --- a/src/Client/CanvasUpdate.fs +++ b/src/Client/CanvasUpdate.fs @@ -271,9 +271,9 @@ let archiveCanvasDocResult (scopedKey: string) (filename: string) (result: Resul /// The two clipboard formats written on a successful share (see `buildClipboardPayload`). type ClipboardPayload = { /// `text/html` — a titled `` so rich targets (Teams, Slack, Outlook, Gmail, Word) render a - /// hyperlink whose visible text is the doc title, hiding the long SAS URL. + /// hyperlink whose visible text is the doc title. Html: string - /// `text/plain` — the raw SAS URL, for plain targets (the VS Code editor, a terminal, Notepad). + /// `text/plain` — the raw viewer URL, for plain targets (the VS Code editor, a terminal, Notepad). Text: string } /// Escape the four characters that would otherwise break the rich `…` — used for @@ -306,7 +306,7 @@ let canvasDocDiskPath (worktreePath: WorktreePath) (filename: string) = /// user activation / an active document, both of which can be lost across the share network round-trip; /// the permission may be revoked; or the API/`ClipboardItem` may be unavailable, which throws /// synchronously). Every one of those paths dispatches an `Error` so the success banner can correct its -/// "link copied" claim instead of lying (F6). `payload.Text` is the raw SAS URL, threaded into the +/// "link copied" claim instead of lying (F6). `payload.Text` is the raw viewer URL, threaded into the /// result so a failed copy can still surface a manually-copyable link. let private writeClipboardCmd (scopedKey: string) (filename: string) (payload: ClipboardPayload) : Cmd = Cmd.ofEffect (fun dispatch -> @@ -429,7 +429,7 @@ let shareCanvasDocResult (scopedKey: string) (filename: string) (result: Result< /// Banner text for a *settled* clipboard write after a successful share (Decision #10). A landed write /// confirms the copy ("Shared — link copied"); a rejected write drops the false "copied" claim, tells -/// the user the link is ready, and surfaces the raw SAS URL as selectable text so they can still copy +/// the user the link is ready, and surfaces the raw viewer URL as selectable text so they can still copy /// it by hand. Pure so the copied-vs-manual text is unit-testable without a browser clipboard. let clipboardResultNotice (url: string) (outcome: Result) : string = match outcome with diff --git a/src/Client/index.html b/src/Client/index.html index 2d71e21e..389560a2 100644 --- a/src/Client/index.html +++ b/src/Client/index.html @@ -836,7 +836,7 @@ } .canvas-share-btn .btn-icon { width: 14px; height: 14px; } .canvas-share-btn:hover { color: #a6e3a1; border-color: #a6e3a1; opacity: 1; } - /* Publishing is a multi-second round-trip (Entra token + user delegation key + upload). Hold the + /* Publishing is a multi-second round-trip (delegated Azure authentication + upload). Hold the button lit and spinning for the whole wait — the same reason .auto-sync-btn.syncing exists: without it an in-flight share is indistinguishable from a button that did nothing. */ .canvas-share-btn.sharing { opacity: 1; color: #a6e3a1; border-color: #a6e3a1; cursor: default; } diff --git a/src/Server/CanvasShare.fs b/src/Server/CanvasShare.fs index cc4526d6..5f081530 100644 --- a/src/Server/CanvasShare.fs +++ b/src/Server/CanvasShare.fs @@ -1,34 +1,27 @@ -/// Publishes an already-exported, standalone canvas doc to Azure Blob Storage and mints a per-doc, -/// read-only SAS URL a recipient can open in a plain browser (no login). Deliberately independent of -/// BOTH the Shared API contract and CanvasExport: `publish` takes an already-exported HTML string -/// plus the doc's filename, so the caller (`WorktreeApi.shareCanvasDocImpl`) owns the export step and -/// the assembly of the `CanvasShareResult`. That keeps this module a thin, replaceable storage -/// adapter with only three dependencies: `Azure.Storage.Blobs`, `Azure.Identity` and `GlobalConfig`. +/// Publishes an already-exported, standalone canvas doc to a pre-provisioned private Azure Blob +/// container and returns its clean authenticated-viewer URL. Deliberately independent of BOTH the +/// Shared API contract and CanvasExport: `publish` takes an already-exported HTML string plus the +/// doc's filename, so `WorktreeApi.shareCanvasDocImpl` owns export and `CanvasShareResult` assembly. /// -/// Credential model (docs/spec/canvas-sharing.md, Decision #3): Treemon stores no storage credential. -/// Links are signed with a *user delegation key* fetched through `AzureCliCredential`, which uses the -/// operator's persisted Azure CLI login. The account rejects Shared Key authorization, so Treemon -/// never handles an account key or connection string. The cost is Azure's hard **7-day** ceiling on a -/// user delegation key — and therefore on every link. +/// Treemon stores no storage credential. A cached `AzureCliCredential` pipeline uses the operator's +/// delegated Azure identity for uploads, while recipients authenticate to the separate viewer and +/// never receive a Blob credential. Each blob carries its own expiry metadata and lands at an +/// unguessable `/` name. The prefix narrows exact lookup but is not an +/// authorization grant: the viewer's Entra gate and synchronous expiry check enforce access. /// -/// Secrecy model (Decisions #2/#4/#5): the container is PRIVATE (anonymous access disabled at the -/// account), the blob lands under an unguessable `/` name, and the returned -/// link is a blob-scoped, read-only, https-only SAS (`sr=b`, `sp=r`, `spr=https`). Because the SAS is -/// blob-scoped, a leaked link exposes exactly one doc; per-doc revoke is a blob delete. -/// -/// The SAS is additionally bound to the *signing identity*: it carries `skoid`/`sktid`. Azure caches -/// role assignments and user delegation keys, so role removal or key revocation invalidates existing -/// links only after cache propagation, not immediately. +/// Shared active HTML is never served directly from Blob Storage. The viewer renders it in the +/// sandbox/CSP boundary described in `docs/spec/canvas-sharing.md`; deleting the backing blob still +/// revokes one document immediately. module Server.CanvasShare open System open System.Collections.Concurrent +open System.Globalization open System.IO open System.Text open Azure.Identity open Azure.Storage.Blobs open Azure.Storage.Blobs.Models -open Azure.Storage.Sas open FsToolkit.ErrorHandling open Server.GlobalConfig @@ -36,51 +29,70 @@ open Server.GlobalConfig /// `/` so it can't muddle the `/` split. let private base62Alphabet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" -/// Length of the random prefix. 22 base62 chars ≈ 131 bits of entropy — far beyond guessable; the -/// SAS signature (not the name) is the real gate anyway (Decision #5). +/// Length of the opaque random prefix. 22 base62 chars ≈ 131 bits of entropy; it is a durable, +/// unguessable lookup identifier while Entra authentication remains the authorization gate. [] let internal PrefixLength = 22 +[] +type internal SharePrefix = + private + | SharePrefix of string + +module internal SharePrefix = + let value (SharePrefix value) = value + +/// Publisher/viewer wire-contract key for the view-time-enforced expiry. +[] +let internal ExpiryMetadataKey = "expiresOn" + +/// Fixed validation error for filenames that cannot be redeemed by the viewer. Kept free of the +/// caller-supplied value so malformed paths are not reflected into logs or client diagnostics. +[] +let internal InvalidFilenameMessage = + "Invalid filename: shared canvas docs must use one filename segment ending in .html." + +/// The publisher half of the filename wire contract. Extension matching is case-insensitive, but +/// the filename itself is never normalized: its original casing must survive the URL and exact Blob +/// lookup. Once both path separators are forbidden, consecutive dots inside the segment are inert. +let internal validateFilename (filename: string) : Result = + let valid = + not (String.IsNullOrEmpty(filename)) + && filename.EndsWith(".html", StringComparison.OrdinalIgnoreCase) + && not (filename.Contains('/')) + && not (filename.Contains('\\')) + + if valid then Ok() else Error InvalidFilenameMessage + /// A fresh high-entropy base62 prefix from the cryptographic RNG. `GetString` samples the alphabet /// uniformly (no modulo bias). Impure (RNG) but shape-testable: right length, alphabet-only, and /// distinct across calls. -let internal generatePrefix () : string = +let internal generatePrefix () : SharePrefix = System.Security.Cryptography.RandomNumberGenerator.GetString(base62Alphabet.AsSpan(), PrefixLength) + |> SharePrefix -/// The leaf of a filename — defends the blob name against a caller passing a doc path rather than a -/// bare name. The live caller validates first, but publishing must never silently create nested -/// blobs from `..`/subdirs. Pure. -let internal leafName (filename: string) : string = - filename.Replace('\\', '/').Split('/') |> Array.last - -/// The blob name a published doc lands at: `/`. The random prefix gives -/// uniqueness + unguessability; the real filename gives the recipient a meaningful page/tab title -/// (Decision #5). Pure given the prefix, so the naming shape is unit-testable. -let internal blobName (prefix: string) (filename: string) : string = - $"{prefix}/{leafName filename}" - -/// Builds the per-doc SAS grant: blob-scoped (`sr=b`, `Resource = "b"`), read-only (`sp=r`), -/// https-only (`spr=https`), expiring at `expiresOn`. Pure — it holds no credential and touches no -/// network (the user delegation key is applied later by `ToSasQueryParameters`), so the exact -/// least-privilege grant is unit-testable in isolation. Least privilege (Decision #2): a recipient of -/// doc A's link cannot read doc B because the signature is bound to A's blob. -/// -/// `expiresOn` must fall inside the delegation key's own validity window or the link is refused at -/// use time regardless of what the token says, so `publish` derives both from one start instant. -let internal buildSasBuilder (containerName: string) (blob: string) (expiresOn: DateTimeOffset) : BlobSasBuilder = - BlobSasBuilder( - BlobSasPermissions.Read, expiresOn, - BlobContainerName = containerName, - BlobName = blob, - Resource = "b", - Protocol = SasProtocol.Https) - -let internal buildSignedBlobUrl - (blobUri: Uri) - (accountName: string) - (delegationKey: UserDelegationKey) - (sasBuilder: BlobSasBuilder) = - $"{blobUri}?{sasBuilder.ToSasQueryParameters(delegationKey, accountName)}" +/// The blob name a published doc lands at: `/`. `publish` admits only one +/// validated filename segment, so this preserves that segment exactly for the viewer's lookup. +let internal blobName (prefix: SharePrefix) (filename: string) : string = + $"{SharePrefix.value prefix}/{filename}" + +/// Builds the upload contract shared with the viewer: UTF-8 HTML plus an exact `expiresOn` +/// metadata value in UTC round-trip form. +let internal buildUploadOptions (expiresOn: DateTimeOffset) = + let headers = BlobHttpHeaders(ContentType = "text/html; charset=utf-8") + let metadata = + dict [ + ExpiryMetadataKey, + expiresOn.ToUniversalTime().ToString("o", CultureInfo.InvariantCulture) + ] + BlobUploadOptions(HttpHeaders = headers, Metadata = metadata) + +/// Constructs a recipient URL without consulting the Blob URI. The filename is encoded as one path +/// segment without changing its casing, and validated config guarantees the base has no query or +/// fragment to carry through. +let internal buildViewerUrl (viewerBaseUrl: Uri) (prefix: SharePrefix) (filename: string) = + let encodedFilename = Uri.EscapeDataString filename + $"{viewerBaseUrl.AbsoluteUri.TrimEnd('/')}/c/{SharePrefix.value prefix}/{encodedFilename}" let private credential = lazy (AzureCliCredential()) @@ -98,10 +110,10 @@ let internal serviceClient (accountName: string) = credential.Value))) client.Value -/// The client-facing "not configured" message names the non-secret account config rather than +/// The client-facing "not configured" message names both required non-secret endpoints rather than /// suggesting an application-managed key or connection string. let internal notConfiguredMessage = - "Canvas sharing is not configured — set canvasShare.accountName in ~/.treemon/config.json to an Azure Storage account name." + "Canvas sharing is not configured — set canvasShare.accountName and an HTTPS canvasShare.viewerBaseUrl in ~/.treemon/config.json." /// The message shown when the host has no usable Entra identity (e.g. `az login` has expired). This /// is the one routine operational failure of the credential model, so it names the fix rather than @@ -109,61 +121,34 @@ let internal notConfiguredMessage = let internal signInRequiredMessage = "Canvas sharing could not authenticate to Azure — run `az login` on this host and try again." -/// Publish an already-exported standalone HTML doc; return a per-doc read-only SAS URL string. -/// -/// Uploads `html` to the PRIVATE container (created on first use if absent) at -/// `/` with `Content-Type: text/html`, then signs a blob-scoped read-only -/// https SAS with an Entra **user delegation key** and returns its absolute URL. Returns `Error` -/// (never throws) when the backend is unconfigured, when the host has no Entra identity, or on any -/// storage failure. No returned message or log line contains the full SAS. +/// Publish an already-exported standalone HTML doc and return its clean viewer URL. /// -/// SECURITY (accepted risk — focused-review F17): `html` is author-controlled canvas content, and it -/// is published as ACTIVE, non-sandboxed HTML/JS with only `Content-Type` — no CSP, no -/// `X-Content-Type-Options`, no sanitization — so whatever JS it contains runs top-level in the -/// recipient's browser for the life of the link. Not sanitized on purpose: that would break the -/// feature's interactivity goal (Decision #6), and a per-blob CSP would need a CDN/proxy. Documented, -/// accepted trade-off — see `docs/spec/canvas-sharing.md` §"Security Posture". +/// Uploads `html` to the configured pre-provisioned private container at +/// `/`, with UTF-8 HTML headers and the exact expiry metadata the viewer +/// enforces. Filename validation runs before configuration or Azure work. Returns `Error` (never +/// throws) when the filename is invalid, either endpoint is unconfigured, the host has no usable +/// delegated identity, or storage fails. Returned errors and logs contain no recipient URL. let publish (filename: string) (html: string) : Async> = asyncResult { + do! validateFilename filename let config = readCanvasShareConfig () let! accountName = config.AccountName |> Result.requireSome notConfiguredMessage + let! viewerBaseUrl = config.ViewerBaseUrl |> Result.requireSome notConfiguredMessage // The try/with stays around the Azure SDK calls (a genuine interop boundary); the - // Option→Error gate above is flattened into the asyncResult track. + // configuration gates above are flattened into the asyncResult track and run before any + // credential acquisition or network call. try let serviceClient = serviceClient accountName - // Backdate the start to absorb clock skew between this host and the storage service, and - // derive the expiry from it so the window stays strictly inside Azure's 7-day limit on a - // user delegation key — at the maximum configured expiry, `expiresOn` is a few minutes - // short of `now + 7d` rather than exactly on the boundary, which the service rejects. - let startsOn = DateTimeOffset.UtcNow.AddMinutes(-5.0) - let expiresOn = startsOn.AddDays(float config.DefaultExpiryDays) - let! delegationKey = - // The explicit CancellationToken selects the (startsOn, expiresOn, ct) overload; with - // two arguments F# binds the same-arity (options, ct) overload instead and fails. - serviceClient.GetUserDelegationKeyAsync( - Nullable startsOn, expiresOn, Threading.CancellationToken.None) - |> Async.AwaitTask + let expiresOn = DateTimeOffset.UtcNow.AddDays(float config.DefaultExpiryDays) let containerClient = serviceClient.GetBlobContainerClient(config.Container) - // Create the PRIVATE container on demand (idempotent) so a fresh account/subscription - // works on first publish — the SDK never auto-creates it, and a missing container - // otherwise fails the upload with 404 ContainerNotFound. PublicAccessType.None keeps - // anonymous access off at the container level (Decision #4). - let! _ = containerClient.CreateIfNotExistsAsync(PublicAccessType.None) |> Async.AwaitTask - let blob = blobName (generatePrefix ()) filename + let prefix = generatePrefix () + let blob = blobName prefix filename let blobClient = containerClient.GetBlobClient(blob) - // charset is declared so non-ASCII doc content isn't mojibaked when the blob is - // opened standalone (the export injects no ). - let headers = BlobHttpHeaders(ContentType = "text/html; charset=utf-8") use stream = new MemoryStream(Encoding.UTF8.GetBytes html) let! _ = - blobClient.UploadAsync(stream, BlobUploadOptions(HttpHeaders = headers)) + blobClient.UploadAsync(stream, buildUploadOptions expiresOn) |> Async.AwaitTask - return - buildSignedBlobUrl - blobClient.Uri - accountName - delegationKey.Value - (buildSasBuilder config.Container blob expiresOn) + return buildViewerUrl viewerBaseUrl prefix filename with | :? AuthenticationFailedException as ex -> // The identity itself is unusable (expired/absent az login). Log the type only — an diff --git a/src/Server/GlobalConfig.fs b/src/Server/GlobalConfig.fs index 6dcae927..f296f778 100644 --- a/src/Server/GlobalConfig.fs +++ b/src/Server/GlobalConfig.fs @@ -281,31 +281,34 @@ let internal writeCanvasSize (size: CanvasSize) = updateGlobalConfig "canvas size" [ "canvasSize", System.Text.Json.Nodes.JsonValue.Create(value) :> System.Text.Json.Nodes.JsonNode ] /// Machine-level config for the canvas Share backend (the `canvasShare` section of `config.json`): -/// which storage account published docs go to, which PRIVATE container they land in, and the default -/// per-doc SAS expiry. Treemon stores no storage credential: links are signed with an Entra *user -/// delegation key* obtained through `AzureCliCredential`, so the account name is ordinary non-secret -/// config (spec docs/spec/canvas-sharing.md, Configuration). +/// which storage account and PRIVATE container receive published docs, their default lifetime, and +/// the HTTPS viewer base URL used for recipient links. These are ordinary non-secret settings; the +/// publisher authenticates to storage with `AzureCliCredential`. type CanvasShareConfig = { AccountName: string option Container: string - DefaultExpiryDays: int } - -/// Defaults for a missing `canvasShare` section or field. `AccountName` has no default — without it -/// there is nothing to publish to, so it is the single value an operator must supply and its absence -/// is what "not configured" means. -let defaultCanvasShareConfig = { AccountName = None; Container = "canvas-shared"; DefaultExpiryDays = 7 } - -/// Upper bound on a configured `defaultExpiryDays`, set by Azure rather than by us: a user delegation -/// key is valid for at most **7 days**, and a SAS signed with it dies when the key does regardless of -/// the expiry written into the token. Requesting more is rejected outright when the key is minted, so -/// a larger — or non-positive — value is treated as absent and falls back to the default. -let internal maxCanvasShareExpiryDays = 7 + DefaultExpiryDays: int + ViewerBaseUrl: Uri option } + +/// Storage has a safe container/lifetime default, but neither deployment-specific endpoint does: +/// both the account and viewer URL must be configured by the operator. The deployed viewer uses +/// `https://treemon.azurewebsites.net`; keeping it out of the default preserves test/deployment +/// isolation and makes an incomplete setup fail closed. +let defaultCanvasShareConfig = + { AccountName = None + Container = "canvas-shared" + DefaultExpiryDays = 7 + ViewerBaseUrl = None } + +/// Durable product limit for a shared document's view-time-enforced lifetime. Lifecycle cleanup is +/// configured beyond this boundary; values outside the range fall back to the seven-day default. +let internal maxCanvasShareExpiryDays = 30 /// Reads the `canvasShare` config section, falling back to `defaultCanvasShareConfig` for a missing -/// section or field. A blank `accountName` or `container`, or a `defaultExpiryDays` outside -/// `1 .. maxCanvasShareExpiryDays`, is treated as absent (a non-positive expiry would mint an -/// already-dead link; one beyond the 7-day user-delegation-key limit would be refused by Azure at -/// publish), so a partial or typo'd section still yields a working config rather than a broken one. +/// section or field. Blank account/container values, a non-HTTPS/invalid `viewerBaseUrl`, or a +/// `defaultExpiryDays` outside `1 .. maxCanvasShareExpiryDays` are treated as absent. User info, +/// non-root paths, query strings, and fragments are not valid on the base URL because published +/// links must use the viewer's root-mounted routes without embedded credentials. let internal readCanvasShareConfig () : CanvasShareConfig = withConfigDocument defaultCanvasShareConfig (fun root -> match root.TryGetProperty("canvasShare") with @@ -315,6 +318,19 @@ let internal readCanvasShareConfig () : CanvasShareConfig = | true, v when v.ValueKind = System.Text.Json.JsonValueKind.String && v.GetString().Trim() <> "" -> Some(v.GetString().Trim()) | _ -> None + let httpsBaseUrl name = + trimmedString name + |> Option.bind (fun value -> + match Uri.TryCreate(value, UriKind.Absolute) with + | true, uri + when uri.Scheme = Uri.UriSchemeHttps + && not (String.IsNullOrWhiteSpace(uri.Host)) + && String.IsNullOrEmpty(uri.UserInfo) + && uri.AbsolutePath = "/" + && String.IsNullOrEmpty(uri.Query) + && String.IsNullOrEmpty(uri.Fragment) -> + Some uri + | _ -> None) let expiryDays = match section.TryGetProperty("defaultExpiryDays") with | true, e when e.ValueKind = System.Text.Json.JsonValueKind.Number -> @@ -324,7 +340,8 @@ let internal readCanvasShareConfig () : CanvasShareConfig = | _ -> defaultCanvasShareConfig.DefaultExpiryDays { AccountName = trimmedString "accountName" Container = trimmedString "container" |> Option.defaultValue defaultCanvasShareConfig.Container - DefaultExpiryDays = expiryDays } + DefaultExpiryDays = expiryDays + ViewerBaseUrl = httpsBaseUrl "viewerBaseUrl" } | _ -> defaultCanvasShareConfig) let internal readLastViewedHashes () : Map> = diff --git a/src/Server/WorktreeApi.fs b/src/Server/WorktreeApi.fs index 2a37fb8b..66d98e12 100644 --- a/src/Server/WorktreeApi.fs +++ b/src/Server/WorktreeApi.fs @@ -106,16 +106,18 @@ let private archiveCanvasDocImpl (request: ArchiveCanvasDocRequest) = File.Move(sourcePath, destPath, overwrite = true) } -/// Share a canvas doc: validate the path → read the on-disk file → static-export it -/// (`CanvasExport.buildStaticHtml` re-injects theme + no-op canvasSend) → publish to Azure Blob and -/// mint a per-doc read-only SAS (`CanvasShare.publish`) → assemble the `CanvasShareResult` with the -/// SAS URL and the doc's resolved title. Mirrors `archiveCanvasDocImpl`. `Title` uses +/// Share a canvas doc: validate the viewer-compatible filename and path → read the on-disk file → +/// static-export it (`CanvasExport.buildStaticHtml` re-injects theme + no-op canvasSend) → publish +/// to Azure Blob and record its expiry (`CanvasShare.publish`) → assemble the `CanvasShareResult` +/// with the clean viewer URL and the doc's resolved title. Mirrors `archiveCanvasDocImpl`. `Title` uses /// `CanvasExport.resolveTitle` (the doc's ``, falling back to a prettified filename) because /// `CanvasShareResult.Title` is a plain string, not an option; the title is read from the original /// HTML (`buildStaticHtml` injects only at `</head>`, so it never alters the doc's `<title>`). -let private shareCanvasDocImpl (request: ShareCanvasDocRequest) : Async<Result<CanvasShareResult, string>> = +let internal shareCanvasDocImpl (request: ShareCanvasDocRequest) : Async<Result<CanvasShareResult, string>> = let path = WorktreePath.value request.WorktreePath asyncResult { + do! Server.CanvasShare.validateFilename request.Filename + let! sourcePath = Server.PathUtils.validateCanvasPath path request.Filename |> Result.mapError (fun reason -> $"Invalid filename: {reason}") @@ -130,9 +132,9 @@ let private shareCanvasDocImpl (request: ShareCanvasDocRequest) : Async<Result<C return! Error $"File not found: {request.Filename}" let html = File.ReadAllText sourcePath - let! sasUrl = Server.CanvasShare.publish request.Filename (Server.CanvasExport.buildStaticHtml html) + let! viewerUrl = Server.CanvasShare.publish request.Filename (Server.CanvasExport.buildStaticHtml html) return - { Url = sasUrl + { Url = viewerUrl Title = Server.CanvasExport.resolveTitle html request.Filename } } diff --git a/src/Shared/Types.fs b/src/Shared/Types.fs index 4b5830af..ed2bf14d 100644 --- a/src/Shared/Types.fs +++ b/src/Shared/Types.fs @@ -528,9 +528,9 @@ type ShareCanvasDocRequest = { WorktreePath: WorktreePath Filename: string } -/// Result of publishing a canvas doc: the per-doc read-only SAS URL plus the doc's title -/// (extracted server-side from the HTML) so the client can build the rich clipboard link -/// without re-parsing. +/// Result of publishing a canvas doc: the clean authenticated-viewer URL plus the doc's title +/// (extracted server-side from the HTML) so the client can build the rich clipboard link without +/// re-parsing. type CanvasShareResult = { Url: string Title: string } diff --git a/src/Tests/CanvasAwarenessTests.fs b/src/Tests/CanvasAwarenessTests.fs index 61bc1eeb..22104a73 100644 --- a/src/Tests/CanvasAwarenessTests.fs +++ b/src/Tests/CanvasAwarenessTests.fs @@ -1171,7 +1171,8 @@ type CanvasDocPathCopyResultTests() = type ShareCanvasDocResultTests() = let shareResult : CanvasShareResult = - { Url = "https://acct.blob.core.windows.net/canvas/x/status.html?sig=s"; Title = "Status" } + { Url = "https://viewer.test/c/0123456789AbCdEfGhIjKl/status.html" + Title = "Status" } let publishingModel sendState = { defaultModel with @@ -1275,7 +1276,7 @@ type ShareCanvasDocResultTests() = Assert.That(notice, Does.Not.Contain("link copied"), "A rejected clipboard write must NOT claim the link was copied (F6)") Assert.That(notice, Does.Contain(shareResult.Url), - "The raw SAS URL must be surfaced so the user can copy it manually") + "The raw viewer URL must be surfaced so the user can copy it manually") | None -> Assert.Fail("A settled clipboard write must still raise the share banner") [<Test>] diff --git a/src/Tests/CanvasShareClientTests.fs b/src/Tests/CanvasShareClientTests.fs index 633888c3..2f41e188 100644 --- a/src/Tests/CanvasShareClientTests.fs +++ b/src/Tests/CanvasShareClientTests.fs @@ -13,29 +13,27 @@ open CanvasUpdate [<Category("Canvas")>] type BuildClipboardPayloadTests() = - // A representative per-doc SAS URL: long, and carrying `&`-separated query params so the test - // also exercises HTML-escaping of the href. - let sasUrl = "https://acct.blob.core.windows.net/canvas/9fA2/build-status.html?sv=2023-11-03&sr=b&sp=r&sig=aB%2Bc%3D" + let viewerUrl = + "https://viewer.test/c/0123456789AbCdEfGhIjKl/build-status.html" [<Test>] member _.``Writes BOTH formats: titled text/html anchor + plain-text URL``() = - let result = { Url = sasUrl; Title = "Build Status Report" } + let result = { Url = viewerUrl; Title = "Build Status Report" } let payload = buildClipboardPayload result // text/plain is the raw URL, verbatim (plain targets get the link itself). - Assert.That(payload.Text, Is.EqualTo(sasUrl), "text/plain must be the raw SAS URL") + Assert.That(payload.Text, Is.EqualTo(viewerUrl), "text/plain must be the raw viewer URL") // text/html is a titled anchor: the visible text is the doc title, the href is the URL. Assert.That(payload.Html, Does.StartWith("<a href=\""), "text/html must be an anchor") Assert.That(payload.Html, Does.EndWith("</a>")) Assert.That(payload.Html, Does.Contain(">Build Status Report</a>"), "anchor text must be the title") - // The href is HTML-escaped (the URL's `&` becomes `&`) so the anchor can't be truncated. - Assert.That(payload.Html, Does.Contain("href=\"https://acct.blob.core.windows.net/canvas/9fA2/build-status.html?sv=2023-11-03&sr=b&sp=r&sig=aB%2Bc%3D\""), - "href must carry the full, HTML-escaped SAS URL") + Assert.That(payload.Html, Does.Contain($"href=\"{viewerUrl}\""), + "href must carry the full clean viewer URL") [<Test>] member _.``HTML-special characters in the title are escaped in the anchor text``() = - let result = { Url = "https://acct.blob.core.windows.net/canvas/x/a.html?sig=x"; Title = "A & B <tag> \"q\"" } + let result = { Url = viewerUrl; Title = "A & B <tag> \"q\"" } let payload = buildClipboardPayload result Assert.That(payload.Html, Does.Contain(">A & B <tag> "q"</a>"), diff --git a/src/Tests/CanvasShareTests.fs b/src/Tests/CanvasShareTests.fs index ba63a530..91c2eb8b 100644 --- a/src/Tests/CanvasShareTests.fs +++ b/src/Tests/CanvasShareTests.fs @@ -4,57 +4,118 @@ open System open System.IO open System.Text.RegularExpressions open NUnit.Framework -open Azure.Storage.Blobs.Models -open Azure.Storage.Sas open Server open Server.CanvasShare open Server.GlobalConfig +open Shared open Tests.TestUtils -// This suite covers only the PURE and deterministic parts of the publish backend (spec -// docs/spec/canvas-sharing.md): blob naming, user-delegation signing, service-client reuse and the -// config reader — plus the unconfigured gate, which fails before any credential or network use. -// The Azure round-trip cannot be emulated (Azurite does not implement GetUserDelegationKey), so it is -// verified against the real account instead — see the spec's "Verification" section. - -// ── blob naming (pure) ──────────────────────────────────────────────────────── +// Pure publisher contracts plus the fail-before-network configuration gate. The real Azure +// round-trip is covered by the deployment verification described in docs/spec/canvas-sharing.md. [<TestFixture>] [<Category("Unit")>] [<Category("Fast")>] -type BlobNamingTests() = +type ShareFilenameContractTests() = - [<Test>] - member _.``blobName joins the prefix and filename with a slash``() = - Assert.That(blobName "PREFIX123" "build-status.html", Is.EqualTo("PREFIX123/build-status.html")) + let validPrefix = "0123456789AbCdEfGhIjKl" - [<Test>] - member _.``blobName keeps the real filename so the recipient sees a meaningful title``() = - // Decision #5: the real filename is preserved (not hashed) after the unguessable prefix. - Assert.That(blobName "abc" "weekly-sync.html", Does.EndWith("/weekly-sync.html")) + [<TestCase("status.html")>] + [<TestCase("Status.HTML")>] + [<TestCase("release..notes.html")>] + member _.``publisher and viewer accept the same valid filename``(filename: string) = + let prefix = generatePrefix () + let prefixValue = SharePrefix.value prefix - [<Test>] - member _.``blobName uses only the leaf so a nested path cannot create nested blobs``() = - Assert.That(blobName "P" "sub/dir/x.html", Is.EqualTo("P/x.html")) + Assert.Multiple(fun () -> + Assert.That( + validateFilename filename |> Result.isOk, + Is.True, + "publisher") + Assert.That( + CanvasShareViewer.SharePath.tryCreate + validPrefix + filename + |> Option.isSome, + Is.True, + "viewer") + Assert.That( + blobName prefix filename, + Is.EqualTo($"{prefixValue}/{filename}"), + "exact Blob name")) + + [<TestCase("")>] + [<TestCase("notes.txt")>] + [<TestCase("folder/notes.html")>] + [<TestCase(@"folder\notes.html")>] + [<TestCase("../notes.html")>] + member _.``publisher and viewer reject the same invalid filename``(filename: string) = + let publisherError = + match validateFilename filename with + | Error error -> error + | Ok() -> + Assert.Fail($"Publisher accepted invalid filename '{filename}'.") + "" - [<Test>] - member _.``leafName strips a forward-slash directory``() = - Assert.That(leafName "a/b/c.html", Is.EqualTo("c.html")) + Assert.Multiple(fun () -> + Assert.That( + publisherError, + Is.EqualTo(InvalidFilenameMessage), + "publisher") + Assert.That( + CanvasShareViewer.SharePath.tryCreate + validPrefix + filename + |> Option.isNone, + Is.True, + "viewer")) + + [<TestCase("notes.txt")>] + [<TestCase("folder/notes.html")>] + [<TestCase(@"folder\notes.html")>] + [<TestCase("../notes.html")>] + member _.``share API rejects invalid filename before file or upload work``(filename: string) = + withTempDir "canvas-share-filename" (fun worktreePath -> + let request = + { WorktreePath = WorktreePath worktreePath + Filename = filename } + + match WorktreeApi.shareCanvasDocImpl request |> runAsync with + | Error error -> + Assert.That( + error, + Is.EqualTo(InvalidFilenameMessage)) + | Ok result -> + Assert.Fail( + $"Expected invalid filename Error before publishing, got Ok {result}")) + +[<TestFixture>] +[<Category("Unit")>] +[<Category("Fast")>] +type BlobNamingTests() = [<Test>] - member _.``leafName strips a backslash directory``() = - Assert.That(leafName @"a\b\c.html", Is.EqualTo("c.html")) + member _.``blobName joins the prefix and filename with a slash``() = + let prefix = generatePrefix () + let prefixValue = SharePrefix.value prefix + + Assert.That( + blobName prefix "build-status.html", + Is.EqualTo($"{prefixValue}/build-status.html")) [<Test>] - member _.``leafName leaves a bare filename untouched``() = - Assert.That(leafName "build-status.html", Is.EqualTo("build-status.html")) + member _.``blobName keeps the real filename so the recipient sees a meaningful title``() = + Assert.That( + blobName (generatePrefix ()) "weekly-sync.html", + Does.EndWith("/weekly-sync.html")) [<Test>] member _.``generatePrefix is PrefixLength base62 characters``() = let prefix = generatePrefix () - Assert.That(prefix.Length, Is.EqualTo(PrefixLength), + let value = SharePrefix.value prefix + Assert.That(value.Length, Is.EqualTo(PrefixLength), "the prefix must be the fixed high-entropy length") - Assert.That(Regex.IsMatch(prefix, "^[0-9A-Za-z]+$"), Is.True, + Assert.That(Regex.IsMatch(value, "^[0-9A-Za-z]+$"), Is.True, "the prefix must be base62 (digits + letters), URL-safe with no separators") [<Test>] @@ -66,79 +127,113 @@ type BlobNamingTests() = "every minted prefix must be distinct") -// ── SAS grant parameters (pure) ─────────────────────────────────────────────── - [<TestFixture>] [<Category("Unit")>] [<Category("Fast")>] -type SasBuilderTests() = +type UploadContractTests() = - let expiresOn = DateTimeOffset(2030, 1, 1, 0, 0, 0, TimeSpan.Zero) - let build () = buildSasBuilder "canvas-shared" "prefix/doc.html" expiresOn + let expiresOn = + DateTimeOffset(2030, 1, 2, 3, 4, 5, TimeSpan.FromHours(2.0)) [<Test>] - member _.``buildSasBuilder scopes the grant to a single blob (sr=b)``() = - // Blob-scoped is the crux of least privilege (Decision #2): doc A's link can't read doc B. - Assert.That(build().Resource, Is.EqualTo("b")) + member _.``upload writes only expiresOn metadata in UTC round-trip form``() = + let options = buildUploadOptions expiresOn - [<Test>] - member _.``buildSasBuilder grants read-only permission (sp=r)``() = - Assert.That(build().Permissions, Is.EqualTo("r"), - "a shared link must be read-only — no write/delete/list") + Assert.Multiple(fun () -> + Assert.That(options.Metadata.Count, Is.EqualTo(1)) + Assert.That(options.Metadata.ContainsKey(ExpiryMetadataKey), Is.True) + Assert.That(ExpiryMetadataKey, Is.EqualTo("expiresOn")) + Assert.That( + options.Metadata[ExpiryMetadataKey], + Is.EqualTo("2030-01-02T01:04:05.0000000+00:00"))) [<Test>] - member _.``buildSasBuilder restricts the link to https (spr=https)``() = - Assert.That(build().Protocol, Is.EqualTo(SasProtocol.Https)) + member _.``upload declares UTF-8 HTML``() = + Assert.That( + (buildUploadOptions expiresOn).HttpHeaders.ContentType, + Is.EqualTo("text/html; charset=utf-8")) [<Test>] - member _.``buildSasBuilder carries the requested expiry``() = - Assert.That(build().ExpiresOn, Is.EqualTo(expiresOn)) + member _.``publisher expiry metadata satisfies the viewer wire contract``() = + let metadata = + (buildUploadOptions expiresOn).Metadata + |> Seq.map (fun pair -> pair.Key, pair.Value) + |> Map.ofSeq + let justBeforeExpiry = + expiresOn.ToUniversalTime().AddTicks(-1L) - [<Test>] - member _.``buildSasBuilder binds the container and blob name``() = - let b = buildSasBuilder "my-container" "abc/report.html" expiresOn - Assert.That(b.BlobContainerName, Is.EqualTo("my-container")) - Assert.That(b.BlobName, Is.EqualTo("abc/report.html")) + Assert.Multiple(fun () -> + Assert.That( + ExpiryMetadataKey, + Is.EqualTo(CanvasShareViewer.ShareExpiry.MetadataKey)) + Assert.That( + CanvasShareViewer.ShareExpiry.isLive + justBeforeExpiry + metadata, + Is.True)) [<TestFixture>] [<Category("Unit")>] [<Category("Fast")>] -type UserDelegationSigningTests() = - - let startsOn = DateTimeOffset(2030, 1, 1, 0, 0, 0, TimeSpan.Zero) - let expiresOn = startsOn.AddDays(7.0) - let delegationKey = - BlobsModelFactory.UserDelegationKey( - "object-id", - "tenant-id", - startsOn, - expiresOn, - "b", - "2025-11-05", - Convert.ToBase64String(Array.create 32 42uy)) +type ViewerUrlTests() = - [<Test>] - member _.``buildSignedBlobUrl applies the delegation identity and blob-scoped grant``() = - let blobUri = Uri("https://tmcanvasabc.blob.core.windows.net/canvas-shared/prefix/doc.html") - let signedUrl = - buildSignedBlobUrl - blobUri - "tmcanvasabc" - delegationKey - (buildSasBuilder "canvas-shared" "prefix/doc.html" expiresOn) - let signedUri = Uri signedUrl + let prefix = generatePrefix () + let prefixValue = SharePrefix.value prefix - Assert.Multiple(fun () -> - Assert.That(signedUri.GetLeftPart(UriPartial.Path), Is.EqualTo(blobUri.AbsoluteUri)) - Assert.That(signedUri.Query, Does.Contain("skoid=object-id")) - Assert.That(signedUri.Query, Does.Contain("sktid=tenant-id")) - Assert.That(signedUri.Query, Does.Contain("sks=b")) - Assert.That(signedUri.Query, Does.Contain("sp=r")) - Assert.That(signedUri.Query, Does.Contain("spr=https")) - Assert.That(signedUri.Query, Does.Contain("sr=b"))) + [<Test>] + member _.``viewer URL uses the canonical deployed origin and clean c path``() = + let url = + buildViewerUrl + (Uri("https://treemon.azurewebsites.net")) + prefix + "status.html" + + Assert.That( + url, + Is.EqualTo( + $"https://treemon.azurewebsites.net/c/{prefixValue}/status.html")) + [<Test>] + member _.``viewer URL uses the configured HTTPS host``() = + let url = + buildViewerUrl + (Uri("https://isolated-viewer.test:7443")) + prefix + "status.html" + + Assert.That( + url, + Is.EqualTo( + $"https://isolated-viewer.test:7443/c/{prefixValue}/status.html")) -// ── config reader (touches TREEMON_CONFIG_DIR: non-parallel) ─────────────────── + [<Test>] + member _.``viewer URL percent-encodes the filename as one path segment``() = + let url = + buildViewerUrl + (Uri("https://viewer.test")) + prefix + "Q3 report #1.html" + + Assert.That( + url, + Is.EqualTo( + "https://viewer.test/c/" + + prefixValue + + "/Q3%20report%20%231.html")) + + [<TestCase("Status.HTML")>] + [<TestCase("release..notes.html")>] + member _.``viewer URL preserves the exact compatible filename``(filename: string) = + let url = + buildViewerUrl + (Uri("https://viewer.test")) + prefix + filename + + Assert.That( + url, + Is.EqualTo( + $"https://viewer.test/c/{prefixValue}/{filename}")) [<TestFixture>] [<Category("Unit")>] @@ -162,19 +257,25 @@ type CanvasShareConfigTests() = Assert.That(readCanvasShareConfig (), Is.EqualTo(defaultCanvasShareConfig))) [<Test>] - member _.``readCanvasShareConfig reads accountName, container and defaultExpiryDays``() = + member _.``readCanvasShareConfig reads every non-secret publisher setting``() = withTempConfigDir "canvas-share-config" (fun dir -> - seed dir """{ "canvasShare": { "accountName": "tmcanvasabc", "container": "shared-docs", "defaultExpiryDays": 3 } }""" + seed dir + """{ "canvasShare": { "accountName": "tmcanvasabc", "container": "shared-docs", "defaultExpiryDays": 3, "viewerBaseUrl": "https://treemon.azurewebsites.net" } }""" let config = readCanvasShareConfig () Assert.That(config.AccountName, Is.EqualTo(Some "tmcanvasabc")) Assert.That(config.Container, Is.EqualTo("shared-docs")) - Assert.That(config.DefaultExpiryDays, Is.EqualTo(3))) + Assert.That(config.DefaultExpiryDays, Is.EqualTo(3)) + Assert.That( + config.ViewerBaseUrl, + Is.EqualTo(Some(Uri("https://treemon.azurewebsites.net"))))) [<Test>] - member _.``readCanvasShareConfig has no accountName by default — that is what unconfigured means``() = + member _.``account and viewer URL have no defaults``() = withTempConfigDir "canvas-share-config" (fun dir -> seed dir """{ "canvasShare": { "container": "shared-docs" } }""" - Assert.That(readCanvasShareConfig().AccountName, Is.EqualTo(None))) + let config = readCanvasShareConfig () + Assert.That(config.AccountName, Is.EqualTo(None)) + Assert.That(config.ViewerBaseUrl, Is.EqualTo(None))) [<Test>] member _.``readCanvasShareConfig treats a blank accountName as absent``() = @@ -183,6 +284,43 @@ type CanvasShareConfigTests() = Assert.That(readCanvasShareConfig().AccountName, Is.EqualTo(None), "a whitespace-only account name must not be published to")) + [<Test>] + member _.``readCanvasShareConfig rejects a viewer URL with a non-root path``() = + withTempConfigDir "canvas-share-config" (fun dir -> + seed dir + """{ "canvasShare": { "viewerBaseUrl": " https://isolated-viewer.test:7443/base/ " } }""" + Assert.That(readCanvasShareConfig().ViewerBaseUrl, Is.EqualTo(None))) + + [<Test>] + member _.``readCanvasShareConfig accepts a configurable HTTPS viewer origin``() = + withTempConfigDir "canvas-share-config" (fun dir -> + seed dir + """{ "canvasShare": { "viewerBaseUrl": " https://isolated-viewer.test:7443/ " } }""" + Assert.That( + readCanvasShareConfig().ViewerBaseUrl, + Is.EqualTo(Some(Uri("https://isolated-viewer.test:7443/"))))) + + [<TestCase("")>] + [<TestCase(" ")>] + [<TestCase("http://viewer.test")>] + [<TestCase("https:viewer.test")>] + [<TestCase("viewer.test")>] + [<TestCase("not a URL")>] + member _.``blank malformed or non-HTTPS viewer URL is unconfigured``(value: string) = + withTempConfigDir "canvas-share-config" (fun dir -> + seed dir + $"""{{ "canvasShare": {{ "viewerBaseUrl": "{value}" }} }}""" + Assert.That(readCanvasShareConfig().ViewerBaseUrl, Is.EqualTo(None))) + + [<TestCase("https://viewer.test?credential=no")>] + [<TestCase("https://viewer.test/#fragment")>] + [<TestCase("https://credential@viewer.test")>] + member _.``viewer base URL rejects credential query and fragment components``(value: string) = + withTempConfigDir "canvas-share-config" (fun dir -> + seed dir + $"""{{ "canvasShare": {{ "viewerBaseUrl": "{value}" }} }}""" + Assert.That(readCanvasShareConfig().ViewerBaseUrl, Is.EqualTo(None))) + [<Test>] member _.``readCanvasShareConfig defaults the expiry when only the container is set``() = withTempConfigDir "canvas-share-config" (fun dir -> @@ -197,36 +335,23 @@ type CanvasShareConfigTests() = seed dir """{ "canvasShare": { "container": " " } }""" Assert.That(readCanvasShareConfig().Container, Is.EqualTo(defaultCanvasShareConfig.Container))) - [<Test>] - member _.``readCanvasShareConfig ignores a non-positive expiry (would mint a dead link)``() = + [<TestCase(1)>] + [<TestCase(30)>] + member _.``readCanvasShareConfig accepts a bounded product lifetime``(days: int) = withTempConfigDir "canvas-share-config" (fun dir -> - seed dir """{ "canvasShare": { "defaultExpiryDays": 0 } }""" - Assert.That(readCanvasShareConfig().DefaultExpiryDays, - Is.EqualTo(defaultCanvasShareConfig.DefaultExpiryDays))) + seed dir + $"""{{ "canvasShare": {{ "defaultExpiryDays": {days} }} }}""" + Assert.That(readCanvasShareConfig().DefaultExpiryDays, Is.EqualTo(days))) - [<Test>] - member _.``readCanvasShareConfig ignores an expiry beyond the user-delegation-key limit``() = + [<TestCase(0)>] + [<TestCase(31)>] + member _.``readCanvasShareConfig rejects a lifetime outside one through thirty``(days: int) = withTempConfigDir "canvas-share-config" (fun dir -> - // A user delegation key lives at most 7 days; Azure refuses a longer window outright when - // the key is minted, so an over-long config value must fall back rather than fail at publish. - seed dir """{ "canvasShare": { "defaultExpiryDays": 30 } }""" + seed dir + $"""{{ "canvasShare": {{ "defaultExpiryDays": {days} }} }}""" Assert.That(readCanvasShareConfig().DefaultExpiryDays, Is.EqualTo(defaultCanvasShareConfig.DefaultExpiryDays))) - [<Test>] - member _.``readCanvasShareConfig accepts the maximum bounded expiry``() = - withTempConfigDir "canvas-share-config" (fun dir -> - seed dir """{ "canvasShare": { "defaultExpiryDays": 7 } }""" - Assert.That(readCanvasShareConfig().DefaultExpiryDays, Is.EqualTo(maxCanvasShareExpiryDays))) - - [<Test>] - member _.``the expiry ceiling is Azure's 7-day user-delegation-key limit``() = - // Pinned deliberately: raising this constant would mint links Azure refuses to sign. - Assert.That(maxCanvasShareExpiryDays, Is.EqualTo(7)) - - -// ── unconfigured / credential gate ───────────────────────────────────────────── - [<TestFixture>] [<Category("Unit")>] [<Category("Fast")>] @@ -235,6 +360,22 @@ type CanvasShareConfigTests() = [<NonParallelizable>] type PublishConfigGateTests() = + let seed (dir: string) (json: string) = + File.WriteAllText(Path.Combine(dir, "config.json"), json) + + [<TestCase("notes.txt")>] + [<TestCase("folder/notes.html")>] + [<TestCase(@"folder\notes.html")>] + [<TestCase("../notes.html")>] + member _.``publish rejects an invalid filename before configuration or Azure``(filename: string) = + withTempConfigDir "canvas-share-publish" (fun _ -> + match runAsync (publish filename "<html></html>") with + | Error msg -> + Assert.That(msg, Is.EqualTo(InvalidFilenameMessage)) + | Ok url -> + Assert.Fail( + $"expected invalid filename Error before publishing, got Ok {url}")) + [<Test>] member _.``serviceClient reuses one Azure authentication pipeline per account``() = let first = serviceClient "tmcanvasabc" @@ -242,10 +383,10 @@ type PublishConfigGateTests() = Assert.That(serviceClient "tmcanvasxyz", Is.Not.SameAs(first)) [<Test>] - member _.``publish returns the not-configured error when no account name is set``() = - // Without an account name there is nothing to publish to, so publish must fail closed - // BEFORE acquiring a credential or touching the network. - withTempConfigDir "canvas-share-publish" (fun _ -> + member _.``publish fails before network when account name is missing``() = + withTempConfigDir "canvas-share-publish" (fun dir -> + seed dir + """{ "canvasShare": { "viewerBaseUrl": "https://isolated-viewer.test" } }""" match runAsync (publish "doc.html" "<html></html>") with | Error msg -> Assert.That(msg, Is.EqualTo(notConfiguredMessage)) @@ -253,10 +394,20 @@ type PublishConfigGateTests() = "the error must tell the operator which config key to set") | Ok url -> Assert.Fail($"expected Error when unconfigured, got Ok {url}")) + [<Test>] + member _.``publish fails before network when viewer URL is missing``() = + withTempConfigDir "canvas-share-publish" (fun dir -> + seed dir + """{ "canvasShare": { "accountName": "network-must-not-be-contacted" } }""" + match runAsync (publish "doc.html" "<html></html>") with + | Error msg -> + Assert.That(msg, Is.EqualTo(notConfiguredMessage)) + Assert.That(msg, Does.Contain("canvasShare.viewerBaseUrl"), + "the error must tell the operator which config key to set") + | Ok url -> Assert.Fail($"expected Error when unconfigured, got Ok {url}")) + [<Test>] member _.``the not-configured message names no application-managed storage credential``() = - // Treemon stores no account key or connection string, so the message must not send an - // operator hunting for one. Assert.That(notConfiguredMessage, Does.Not.Contain("AZURE_STORAGE_CONNECTION_STRING")) Assert.That(notConfiguredMessage.ToLowerInvariant(), Does.Not.Contain("key")) diff --git a/src/Tests/CanvasShareViewerContainmentTestHelpers.fs b/src/Tests/CanvasShareViewerContainmentTestHelpers.fs new file mode 100644 index 00000000..cb5009d8 --- /dev/null +++ b/src/Tests/CanvasShareViewerContainmentTestHelpers.fs @@ -0,0 +1,274 @@ +module Tests.CanvasShareViewerContainmentTestHelpers + +open System +open System.Collections.Concurrent +open System.Globalization +open System.IO +open System.Net +open System.Text +open System.Threading +open System.Threading.Tasks +open CanvasShareViewer +open Microsoft.AspNetCore.Builder +open Microsoft.AspNetCore.Hosting +open Microsoft.AspNetCore.Http +open Tests.TestUtils + +let validPrefix = "0123456789ABCDEFGHIJKL" + +let private fixedNow = + DateTimeOffset( + 2030, + 1, + 1, + 0, + 0, + 0, + TimeSpan.Zero + ) + +let private liveMetadata = + Map [ + ShareExpiry.MetadataKey, + fixedNow + .AddHours(1.0) + .ToString("o", CultureInfo.InvariantCulture) + ] + +let private fixturePath (filename: string) = + Path.Combine( + __SOURCE_DIRECTORY__, + "fixtures", + "canvas-share-viewer", + filename + ) + +let private exportedFixture + (filename: string) + (replacements: (string * string) list) + : string + = + replacements + |> List.fold + (fun (content: string) (placeholder, value) -> + content.Replace( + placeholder, + value, + StringComparison.Ordinal + )) + (File.ReadAllText(fixturePath filename)) + |> Server.CanvasExport.buildStaticHtml + +type private StoredBlobDocument = + { Content: byte array + Metadata: Map<string, string> } + +let private blobDocument (content: string) : StoredBlobDocument = + { Content = + content + |> Encoding.UTF8.GetBytes + Metadata = liveMetadata } + +let private openBlobDocument + (stored: StoredBlobDocument) + : BlobDocument + = + { Content = + new MemoryStream(stored.Content, false) + :> Stream + ContentLength = int64 stored.Content.LongLength + Metadata = stored.Metadata } + +let private isolatedPorts () = + let rec reserve () = + let ports = getFreeTcpPorts 2 + + if ports |> List.contains 5000 then + reserve () + else + ports + + match reserve () with + | [ viewerPort; probePort ] -> + viewerPort, probePort + | _ -> + failwith "Expected exactly two isolated ports." + +type ContainmentHarness = + { ViewerBaseUrl: string + ProbeBaseUrl: string + ViewerPort: int + ProbePort: int + BlobRequests: ConcurrentQueue<string> + ProbeRequests: ConcurrentQueue<string> } + +let private startProbe + port + (requests: ConcurrentQueue<string>) + = + let builder = + WebApplication.CreateEmptyBuilder( + WebApplicationOptions() + ) + + builder.WebHost.UseKestrel(fun options -> + options.Listen(IPAddress.Loopback, port)) + |> ignore + + let app = builder.Build() + + let gif = + Convert.FromBase64String( + "R0lGODlhAQABAIAAAAAAAP///ywAAAAAAQABAAACAUwAOw==" + ) + + app.Run( + RequestDelegate(fun context -> + task { + requests.Enqueue( + $"{context.Request.Method} http://127.0.0.1:{port}{context.Request.Path}{context.Request.QueryString}" + ) + + context.Response.Headers["Access-Control-Allow-Origin"] <- + "*" + + if + context.Request.Path.Value.Contains( + "image", + StringComparison.OrdinalIgnoreCase + ) + then + context.Response.ContentType <- "image/gif" + do! + context.Response.Body.WriteAsync( + gif, + context.RequestAborted + ) + else + context.Response.ContentType <- "text/plain" + do! context.Response.WriteAsync("probe-response") + }) + ) + + app + +let withContainmentHarness + (action: ContainmentHarness -> Task) + = + task { + let viewerPort, probePort = isolatedPorts () + let viewerBaseUrl = + $"http://127.0.0.1:{viewerPort}" + let probeBaseUrl = + $"http://127.0.0.1:{probePort}" + let probeRequests = + ConcurrentQueue<string>() + use probe = + startProbe probePort probeRequests + do! probe.StartAsync(CancellationToken.None) + + let hostile = + exportedFixture + "hostile.html" + [ + "{{PROBE_BASE_URL}}", probeBaseUrl + ] + + let selfNavigationDocuments = + [ + "self-location" + "self-replace" + "self-target" + ] + |> List.map (fun navigationKind -> + let content = + exportedFixture + "self-navigation.html" + [ + "{{PROBE_BASE_URL}}", + probeBaseUrl + "{{NAVIGATION_KIND}}", + navigationKind + ] + + $"{validPrefix}/{navigationKind}.html", + blobDocument content) + + let benign = + exportedFixture "self-contained.html" [] + + let documents = + [ + $"{validPrefix}/hostile.html", + blobDocument hostile + $"{validPrefix}/self-contained.html", + blobDocument benign + ] + @ selfNavigationDocuments + |> Map.ofList + + let blobRequests = + ConcurrentQueue<string>() + + let reader = + { ReadPropertiesExact = + fun blobName _ -> + blobRequests.Enqueue( + $"PROPERTIES {blobName}" + ) + + documents + |> Map.tryFind blobName + |> Option.map _.Metadata + |> Task.FromResult + ReadExact = + fun blobName _ -> + blobRequests.Enqueue( + $"CONTENT {blobName}" + ) + + documents + |> Map.tryFind blobName + |> Option.map openBlobDocument + |> Task.FromResult } + + let builder = + WebApplication.CreateEmptyBuilder( + WebApplicationOptions() + ) + + builder.WebHost.UseKestrel(fun options -> + options.Listen( + IPAddress.Loopback, + viewerPort + )) + |> ignore + + use viewer = + ViewerApplication.create + builder + reader + (fun () -> fixedNow) + + do! viewer.StartAsync(CancellationToken.None) + + try + do! + action + { ViewerBaseUrl = viewerBaseUrl + ProbeBaseUrl = probeBaseUrl + ViewerPort = viewerPort + ProbePort = probePort + BlobRequests = blobRequests + ProbeRequests = probeRequests } + finally + viewer + .StopAsync(CancellationToken.None) + .GetAwaiter() + .GetResult() + + probe + .StopAsync(CancellationToken.None) + .GetAwaiter() + .GetResult() + } diff --git a/src/Tests/CanvasShareViewerContainmentTests.fs b/src/Tests/CanvasShareViewerContainmentTests.fs new file mode 100644 index 00000000..24581cef --- /dev/null +++ b/src/Tests/CanvasShareViewerContainmentTests.fs @@ -0,0 +1,743 @@ +module Tests.CanvasShareViewerContainmentTests + +open System +open System.Collections.Concurrent +open System.IO +open System.Text.Json +open Microsoft.Playwright +open Microsoft.Playwright.NUnit +open NUnit.Framework +open Tests.CanvasShareViewerContainmentTestHelpers + +let private artifactDirectory () = + Environment.GetEnvironmentVariable( + "CANVAS_VIEWER_VERIFICATION_ARTIFACT_DIR" + ) + |> Option.ofObj + |> Option.map _.Trim() + |> Option.filter (not << String.IsNullOrWhiteSpace) + |> Option.map (fun path -> + Directory.CreateDirectory(path) |> ignore + path) + +let private writeArtifact + (filename: string) + (content: string) + = + artifactDirectory () + |> Option.iter (fun directory -> + File.WriteAllText( + Path.Combine(directory, filename), + content + )) + +let private captureScreenshot + filename + (page: IPage) + = + task { + match artifactDirectory () with + | Some directory -> + let! _ = + page.ScreenshotAsync( + PageScreenshotOptions( + Path = Path.Combine( + directory, + filename + ), + FullPage = true + ) + ) + () + | None -> + () + } + +let private seedViewerOrigin + (page: IPage) + (harness: ContainmentHarness) + = + task { + let url = + $"{harness.ViewerBaseUrl}/c/{validPrefix}/self-contained.html" + + let! response = page.GotoAsync(url) + + Assert.That( + response.Status, + Is.EqualTo(200), + "the live viewer shell must be available before storage is seeded" + ) + + return! + page.EvaluateAsync<string>( + """() => { + document.cookie = 'viewer-auth=viewer-cookie-secret; path=/'; + localStorage.setItem('viewer-auth', 'viewer-storage-secret'); + return JSON.stringify({ + cookie: document.cookie, + storage: localStorage.getItem('viewer-auth') + }); + }""" + ) + } + +let private observePage + (page: IPage) + = + let requests = ConcurrentQueue<string>() + let responses = ConcurrentQueue<string>() + let requestFailures = ConcurrentQueue<string>() + let popups = ConcurrentQueue<string>() + let consoleMessages = ConcurrentQueue<string>() + let pageErrors = ConcurrentQueue<string>() + + page.Request.Add(fun request -> + requests.Enqueue( + $"{request.Method} {request.Url}" + )) + + page.Response.Add(fun response -> + responses.Enqueue( + $"{response.Status} {response.Url}" + )) + + page.RequestFailed.Add(fun request -> + requestFailures.Enqueue( + $"{request.Method} {request.Url} :: {request.Failure}" + )) + + page.Popup.Add(fun popup -> + popups.Enqueue(popup.Url)) + + page.Console.Add(fun message -> + consoleMessages.Enqueue( + $"{message.Type}: {message.Text}" + )) + + page.PageError.Add(fun error -> + pageErrors.Enqueue(string error)) + + requests, + responses, + requestFailures, + popups, + consoleMessages, + pageErrors + +let private escapeRequests + (harness: ContainmentHarness) + (requests: string array) + = + requests + |> Array.filter (fun request -> + request.Contains( + "/__viewer_escape__/", + StringComparison.Ordinal + ) + || request.Contains( + harness.ProbeBaseUrl, + StringComparison.Ordinal + )) + +let private assertHostileOutcomes + (resultJson: string) + = + use document = JsonDocument.Parse(resultJson) + let root = document.RootElement + let stringProperty (name: string) = + root.GetProperty(name).GetString() + + Assert.Multiple(fun () -> + Assert.That( + root.GetProperty("completed").GetBoolean(), + Is.True + ) + + Assert.That( + stringProperty "cookie", + Does.Not.Contain("viewer-cookie-secret"), + "the sandboxed document must not read viewer-origin cookies" + ) + + Assert.That( + stringProperty "localStorage", + Does.Not.Contain("viewer-storage-secret"), + "the sandboxed document must not read viewer-origin local storage" + ) + + Assert.That( + stringProperty "viewerFetch", + Does.StartWith("blocked:"), + "viewer-origin fetch must be blocked before a response is obtained" + ) + + Assert.That( + stringProperty "externalFetch", + Does.StartWith("blocked:"), + "external fetch must be blocked before a response is obtained" + ) + + Assert.That( + stringProperty "image", + Does.StartWith("blocked"), + "remote image exfiltration must be blocked" + ) + + Assert.That( + stringProperty "form", + Is.EqualTo("attempted") + ) + + Assert.That( + stringProperty "popup", + Is.EqualTo("blocked") + )) + +let private assertNoEscape + (harness: ContainmentHarness) + expectedPageUrl + expectedFrameUrl + (page: IPage) + (requests: ConcurrentQueue<string>) + (responses: ConcurrentQueue<string>) + (popups: ConcurrentQueue<string>) + = + let observedRequests = requests.ToArray() + let attemptedEscapeRequests = + escapeRequests harness observedRequests + let escapeResponses = + responses.ToArray() + |> escapeRequests harness + + let childFrameUrls = + page.Frames + |> Seq.filter (fun frame -> + not ( + Object.ReferenceEquals( + frame, + page.MainFrame + ) + )) + |> Seq.map _.Url + |> Array.ofSeq + + Assert.Multiple(fun () -> + Assert.That( + escapeResponses, + Is.Empty, + "no hostile network attempt may obtain a response" + ) + + Assert.That( + harness.ProbeRequests.ToArray(), + Is.Empty, + "the external probe server must receive no request" + ) + + Assert.That( + popups.ToArray(), + Is.Empty, + "the hostile fixture must not open a page" + ) + + Assert.That( + page.Context.Pages.Count, + Is.EqualTo(1), + "the browser context must still contain only the original page" + ) + + Assert.That( + page.Url, + Is.EqualTo(expectedPageUrl), + "the hostile fixture must not navigate the parent or top-level page" + ) + + Assert.That( + childFrameUrls, + Is.EqualTo([| expectedFrameUrl |]) + .Or.EqualTo( + [| "chrome-error://chromewebdata/" |] + ), + "self-navigation must remain on the document or Chromium's local CSP-block page" + ) + + Assert.That( + observedRequests, + Has.None.Contains(":5000"), + "verification must never touch the production port" + ) + + if attemptedEscapeRequests.Length > 0 then + TestContext.Out.WriteLine( + $"Browser-recorded escape attempts (response and probe assertions determine transport):{Environment.NewLine}{String.Join(Environment.NewLine, attemptedEscapeRequests)}" + )) + +type BrowserEvidence = + { Mode: string + ViewerUrl: string + ViewerPort: int + ProbePort: int + Seed: string + Result: string + Requests: string array + Responses: string array + RequestFailures: string array + ProbeRequests: string array + Popups: string array + ConsoleMessages: string array + PageErrors: string array + BlobRequests: string array } + +let private writeBrowserEvidence + filename + evidence + = + let json = + JsonSerializer.Serialize( + evidence, + JsonSerializerOptions(WriteIndented = true) + ) + + TestContext.Out.WriteLine(json) + writeArtifact filename json + +[<TestFixture>] +[<Category("E2E")>] +[<Category("ViewerContainment")>] +[<NonParallelizable>] +type CanvasShareViewerContainmentTests() = + inherit PageTest() + + [<Test>] + member this.``hostile fixture cannot escape the shell iframe``() = + withContainmentHarness (fun harness -> + task { + let! seed = + seedViewerOrigin this.Page harness + + let + (requests, + responses, + requestFailures, + popups, + consoleMessages, + pageErrors) = + observePage this.Page + + let url = + $"{harness.ViewerBaseUrl}/c/{validPrefix}/hostile.html" + + let! response = this.Page.GotoAsync(url) + + Assert.That( + response.Status, + Is.EqualTo(200) + ) + + let results = + this.Page + .FrameLocator("iframe") + .Locator("#hostile-results") + + do! + Assertions + .Expect(results) + .ToHaveAttributeAsync( + "data-complete", + "true", + LocatorAssertionsToHaveAttributeOptions( + Timeout = 10000.0f + ) + ) + + let! resultJson = results.TextContentAsync() + do! this.Page.WaitForTimeoutAsync(700.0f) + + do! + captureScreenshot + "hostile-iframe.png" + this.Page + + writeBrowserEvidence + "hostile-iframe.json" + { Mode = "shell iframe" + ViewerUrl = this.Page.Url + ViewerPort = harness.ViewerPort + ProbePort = harness.ProbePort + Seed = seed + Result = resultJson + Requests = requests.ToArray() + Responses = responses.ToArray() + RequestFailures = + requestFailures.ToArray() + ProbeRequests = + harness.ProbeRequests.ToArray() + Popups = popups.ToArray() + ConsoleMessages = + consoleMessages.ToArray() + PageErrors = pageErrors.ToArray() + BlobRequests = + harness.BlobRequests.ToArray() } + + assertHostileOutcomes resultJson + + assertNoEscape + harness + url + $"{url}/content" + this.Page + requests + responses + popups + }) + + [<TestCase("self-location")>] + [<TestCase("self-replace")>] + [<TestCase("self-target")>] + member this.``each frame self-navigation primitive is independently contained``( + navigationKind: string + ) = + withContainmentHarness (fun harness -> + task { + let + (requests, + responses, + _, + popups, + _, + _) = + observePage this.Page + + let url = + $"{harness.ViewerBaseUrl}/c/{validPrefix}/{navigationKind}.html" + + let! response = this.Page.GotoAsync(url) + + Assert.That( + response.Status, + Is.EqualTo(200) + ) + + let result = + this.Page + .FrameLocator("iframe") + .Locator("#navigation-result") + + do! + Assertions + .Expect(result) + .ToHaveAttributeAsync( + "data-attempted", + "true", + LocatorAssertionsToHaveAttributeOptions( + Timeout = 10000.0f + ) + ) + + let! observedNavigation = + result.GetAttributeAsync( + "data-navigation" + ) + + do! this.Page.WaitForTimeoutAsync(700.0f) + + Assert.That( + observedNavigation, + Is.EqualTo(navigationKind) + ) + + assertNoEscape + harness + url + $"{url}/content" + this.Page + requests + responses + popups + }) + + [<Test>] + member this.``direct content navigation falls back to sandboxed shell containment``() = + withContainmentHarness (fun harness -> + task { + let! seed = + seedViewerOrigin this.Page harness + + let + (requests, + responses, + requestFailures, + popups, + consoleMessages, + pageErrors) = + observePage this.Page + + let url = + $"{harness.ViewerBaseUrl}/c/{validPrefix}/hostile.html/content" + + let! response = this.Page.GotoAsync(url) + + Assert.That( + response.Status, + Is.EqualTo(200) + ) + + let iframe = this.Page.Locator("iframe") + let! sandbox = + iframe.GetAttributeAsync("sandbox") + + let! topLevelHostileResults = + this.Page + .Locator("#hostile-results") + .CountAsync() + + let results = + this.Page + .FrameLocator("iframe") + .Locator("#hostile-results") + + do! + Assertions + .Expect(results) + .ToHaveAttributeAsync( + "data-complete", + "true", + LocatorAssertionsToHaveAttributeOptions( + Timeout = 10000.0f + ) + ) + + let! resultJson = results.TextContentAsync() + do! this.Page.WaitForTimeoutAsync(700.0f) + + Assert.Multiple(fun () -> + Assert.That( + sandbox, + Is.EqualTo("allow-scripts"), + "a top-level content URL must render the normal sandboxed shell" + ) + + Assert.That( + topLevelHostileResults, + Is.Zero, + "the active document must not be emitted into the top-level response" + ) + + Assert.That( + harness.BlobRequests.ToArray(), + Is.EqualTo( + [| + $"PROPERTIES {validPrefix}/self-contained.html" + $"CONTENT {validPrefix}/self-contained.html" + $"PROPERTIES {validPrefix}/hostile.html" + $"CONTENT {validPrefix}/hostile.html" + |] + ), + "each shell load must perform one properties lookup and one iframe body read" + )) + + do! + captureScreenshot + "hostile-direct.png" + this.Page + + writeBrowserEvidence + "hostile-direct.json" + { Mode = + "direct content route shell fallback" + ViewerUrl = this.Page.Url + ViewerPort = harness.ViewerPort + ProbePort = harness.ProbePort + Seed = seed + Result = resultJson + Requests = requests.ToArray() + Responses = responses.ToArray() + RequestFailures = + requestFailures.ToArray() + ProbeRequests = + harness.ProbeRequests.ToArray() + Popups = popups.ToArray() + ConsoleMessages = + consoleMessages.ToArray() + PageErrors = pageErrors.ToArray() + BlobRequests = + harness.BlobRequests.ToArray() } + + assertHostileOutcomes resultJson + + assertNoEscape + harness + url + url + this.Page + requests + responses + popups + }) + + [<Test>] + member this.``benign self-contained scripting remains interactive``() = + withContainmentHarness (fun harness -> + task { + let requests = ConcurrentQueue<string>() + + this.Page.Request.Add(fun request -> + requests.Enqueue( + $"{request.Method} {request.Url}" + )) + + let url = + $"{harness.ViewerBaseUrl}/c/{validPrefix}/self-contained.html" + + let! response = this.Page.GotoAsync(url) + + Assert.That( + response.Status, + Is.EqualTo(200) + ) + + let frame = + this.Page.FrameLocator("iframe") + + let status = + frame.Locator("#execution-status") + + do! + Assertions + .Expect(status) + .ToHaveAttributeAsync( + "data-inline", + "ran" + ) + + do! + Assertions + .Expect(status) + .ToHaveAttributeAsync( + "data-eval", + "ran" + ) + + do! + Assertions + .Expect(status) + .ToHaveAttributeAsync( + "data-dynamic-function", + "ran" + ) + + do! + Assertions + .Expect(status) + .ToHaveAttributeAsync( + "data-canvas-send", + "inert" + ) + + let! color = + status.EvaluateAsync<string>( + "element => getComputedStyle(element).color" + ) + + let image = + frame.Locator("#embedded-image") + + let! imageLoaded = + image.EvaluateAsync<bool>( + "element => element.complete && element.naturalWidth === 1 && element.naturalHeight === 1" + ) + + let details = + frame.Locator("#native-disclosure") + + Assert.That( + details.GetAttributeAsync("open") + .GetAwaiter() + .GetResult(), + Is.Null + ) + + do! + frame + .Locator( + "#native-disclosure summary" + ) + .ClickAsync() + + do! + Assertions + .Expect(details) + .ToHaveAttributeAsync("open", "") + + let observedRequests = requests.ToArray() + let! inlineExecution = + status.GetAttributeAsync("data-inline") + let! evalExecution = + status.GetAttributeAsync("data-eval") + let! newFunctionExecution = + status.GetAttributeAsync( + "data-dynamic-function" + ) + let! canvasSendOutcome = + status.GetAttributeAsync( + "data-canvas-send" + ) + let! disclosureOpen = + details.GetAttributeAsync("open") + + Assert.Multiple(fun () -> + Assert.That( + color, + Is.EqualTo("rgb(20, 90, 160)"), + "inline style must apply" + ) + + Assert.That( + imageLoaded, + Is.True, + "the data image must load" + ) + + Assert.That( + observedRequests, + Has.None.Contains(":5000") + ) + + Assert.That( + escapeRequests + harness + observedRequests, + Is.Empty + )) + + let evidence = + JsonSerializer.Serialize( + {| viewerUrl = this.Page.Url + viewerPort = harness.ViewerPort + probePort = harness.ProbePort + inlineExecution = inlineExecution + evalExecution = evalExecution + newFunctionExecution = + newFunctionExecution + canvasSendOutcome = + canvasSendOutcome + inlineColor = color + dataImageLoaded = imageLoaded + disclosureOpen = disclosureOpen + requests = observedRequests + blobRequests = + harness.BlobRequests.ToArray() |}, + JsonSerializerOptions( + WriteIndented = true + ) + ) + + TestContext.Out.WriteLine(evidence) + writeArtifact "benign.json" evidence + + do! + captureScreenshot + "benign.png" + this.Page + }) diff --git a/src/Tests/CanvasShareViewerTests.fs b/src/Tests/CanvasShareViewerTests.fs new file mode 100644 index 00000000..55ece82f --- /dev/null +++ b/src/Tests/CanvasShareViewerTests.fs @@ -0,0 +1,1598 @@ +module Tests.CanvasShareViewerTests + +open System +open System.Collections.Concurrent +open System.Collections.Generic +open System.Globalization +open System.IO +open System.Net +open System.Net.Http +open System.Net.Http.Headers +open System.Text +open System.Threading +open System.Threading.Tasks +open System.Xml.Linq +open Azure +open Azure.Identity +open CanvasShareViewer +open Microsoft.AspNetCore.Builder +open Microsoft.AspNetCore.Hosting +open Microsoft.AspNetCore.Routing +open Microsoft.Extensions.Configuration +open Microsoft.Extensions.Logging +open NUnit.Framework +open Tests.TestUtils + +let private validPrefix = "0123456789ABCDEFGHIJKL" + +let private shellContentSecurityPolicy = + "default-src 'none'; style-src 'unsafe-inline'; frame-src 'self'; form-action 'none'; base-uri 'none'; frame-ancestors 'none'" + +let private contentContentSecurityPolicy = + "default-src 'none'; script-src 'unsafe-inline' 'unsafe-eval'; style-src 'unsafe-inline'; img-src data:; font-src data:; media-src data:; connect-src 'none'; form-action 'none'; frame-src 'none'; object-src 'none'; base-uri 'none'; frame-ancestors 'self'; sandbox allow-scripts" + +let private dependencyFailureContentSecurityPolicy = + "default-src 'none'; frame-ancestors 'none'; form-action 'none'; base-uri 'none'" + +let private formatExpiry (value: DateTimeOffset) = + value.ToString("o", CultureInfo.InvariantCulture) + +type private StoredBlobDocument = + { Content: byte array + Metadata: Map<string, string> } + +let private storedDocument content metadata = + { Content = content + Metadata = metadata } + +let private document + (content: string) + (metadata: Map<string, string>) + = + storedDocument + (Encoding.UTF8.GetBytes content) + metadata + +let private openDocument + (stored: StoredBlobDocument) + : BlobDocument + = + { Content = + new MemoryStream(stored.Content, false) + :> Stream + ContentLength = int64 stored.Content.LongLength + Metadata = stored.Metadata } + +type private DisposalTrackingStream(content: byte array) = + inherit MemoryStream(content, false) + + // Disposal observation is mutable because Stream.Dispose is an imperative boundary. + let mutable disposed = false + + member _.IsDisposed = disposed + + override this.Dispose(disposing) = + if disposing then + disposed <- true + + base.Dispose(disposing) + +type private BlobLookup = + | PropertiesLookup of string + | ContentRead of string + +type private FakeBlobReader = + { Reader: BlobReader + Requests: unit -> BlobLookup list } + +type private CapturedLog = + { Level: LogLevel + Message: string + Exception: exn option } + +let private nullLogScope = + { new IDisposable with + member _.Dispose() = () } + +type private CapturingLogger + (logs: ConcurrentQueue<CapturedLog>) + = + interface ILogger with + member _.BeginScope<'TState> + (_state: 'TState) + = + nullLogScope + + member _.IsEnabled(_level) = + true + + member _.Log<'TState>( + level, + _eventId, + state: 'TState, + error, + formatter + ) = + logs.Enqueue( + { Level = level + Message = formatter.Invoke(state, error) + Exception = error |> Option.ofObj } + ) + +type private CapturingLoggerProvider() = + // The concurrent queue is confined to this test logger's framework callback boundary. + let logs = ConcurrentQueue<CapturedLog>() + + member _.Entries() = + logs.ToArray() |> List.ofArray + + interface ILoggerProvider with + member _.CreateLogger(_categoryName) = + CapturingLogger(logs) + + member _.Dispose() = () + +let private fakeBlobReader documents = + // Mutation is confined to this fake's request observer; production storage state is immutable. + let mutable requestsRev = [] + + { Reader = + { ReadPropertiesExact = + fun blobName _ -> + requestsRev <- + PropertiesLookup blobName + :: requestsRev + + documents + |> Map.tryFind blobName + |> Option.map _.Metadata + |> Task.FromResult + ReadExact = + fun blobName _ -> + requestsRev <- + ContentRead blobName :: requestsRev + + documents + |> Map.tryFind blobName + |> Option.map openDocument + |> Task.FromResult } + Requests = fun () -> List.rev requestsRev } + +let private withRunningViewer + (app: WebApplication) + port + (action: HttpClient -> string -> unit) + = + use app = app + + app.StartAsync(CancellationToken.None) + .GetAwaiter() + .GetResult() + + try + use client = new HttpClient() + action client $"http://127.0.0.1:{port}" + finally + app.StopAsync(CancellationToken.None) + .GetAwaiter() + .GetResult() + +let private withViewer + documents + now + (action: FakeBlobReader -> HttpClient -> string -> unit) + = + let fake = fakeBlobReader documents + let port = getFreeTcpPort () + let builder = + WebApplication.CreateEmptyBuilder( + WebApplicationOptions() + ) + builder.WebHost.UseKestrel(fun options -> + options.Listen(IPAddress.Loopback, port)) + |> ignore + + let app = + ViewerApplication.create + builder + fake.Reader + (fun () -> now) + + withRunningViewer app port (action fake) + +let private withThrowingViewer + environmentName + (createError: unit -> exn) + now + (action: + CapturingLoggerProvider -> + HttpClient -> + string -> + unit) + = + let port = getFreeTcpPort () + let options = + WebApplicationOptions( + EnvironmentName = environmentName + ) + let builder = WebApplication.CreateBuilder(options) + builder.Logging.ClearProviders() |> ignore + let logs = new CapturingLoggerProvider() + builder.Logging.AddProvider(logs) |> ignore + builder.WebHost.UseKestrel(fun options -> + options.Listen(IPAddress.Loopback, port)) + |> ignore + + let reader = + { ReadPropertiesExact = + fun _ _ -> + createError () + |> Task.FromException<Map<string, string> option> + ReadExact = + fun _ _ -> + createError () + |> Task.FromException<BlobDocument option> } + + let app = + ViewerApplication.create + builder + reader + (fun () -> now) + + withRunningViewer app port (action logs) + +let private await (work: Task<'value>) = + work.GetAwaiter().GetResult() + +let private iframeNavigationHeaders = + [ + "Sec-Fetch-Site", "same-origin" + "Sec-Fetch-Mode", "navigate" + "Sec-Fetch-Dest", "iframe" + ] + +let private sendGetWithHeaders + (headers: (string * string) list) + (client: HttpClient) + (url: string) + = + task { + use request = + new HttpRequestMessage(HttpMethod.Get, url) + + headers + |> List.iter (fun (name, value) -> + request.Headers.TryAddWithoutValidation( + name, + value + ) + |> ignore) + + return! client.SendAsync(request) + } + +let private getIframeContent + (client: HttpClient) + (url: string) + = + sendGetWithHeaders + iframeNavigationHeaders + client + url + +let private headerPairs (headers: HttpHeaders) = + headers + |> Seq.filter (fun header -> + not ( + String.Equals( + header.Key, + "Date", + StringComparison.OrdinalIgnoreCase + ) + )) + |> Seq.map (fun header -> + header.Key, + (header.Value |> Seq.sort |> List.ofSeq)) + +let private responseHeadersWithoutDate + (response: HttpResponseMessage) + = + response.Headers + |> headerPairs + |> Seq.sortBy fst + |> List.ofSeq + +let private expectedPolicyHeaders contentSecurityPolicy = + [ + "Cache-Control", [ "no-store" ] + "Content-Security-Policy", + [ contentSecurityPolicy ] + "Referrer-Policy", [ "no-referrer" ] + "X-Content-Type-Options", [ "nosniff" ] + ] + +let private expectedDependencyFailureHeaders = + ("Content-Length", [ "0" ]) + :: expectedPolicyHeaders + dependencyFailureContentSecurityPolicy + |> List.sortBy fst + +let private parseHtmlDom (html: string) = + html.Replace( + "<!doctype html>", + "", + StringComparison.OrdinalIgnoreCase + ) + |> XDocument.Parse + +let private requiredAttribute + name + (element: XElement) + = + match element.Attribute(XName.Get(name)) |> Option.ofObj with + | Some attribute -> attribute.Value + | None -> + Assert.Fail( + $"Expected <{element.Name.LocalName}> to have a {name} attribute." + ) + "" + +let private selfContainedFixtureBytes () = + Path.Combine( + __SOURCE_DIRECTORY__, + "fixtures", + "canvas-share-viewer", + "self-contained.html" + ) + |> File.ReadAllBytes + +type private ResponseSnapshot = + { StatusCode: HttpStatusCode + Headers: (string * string list) list + Body: byte array } + +let private responseSnapshotWithHeaders + requestHeaders + (client: HttpClient) + (url: string) + : ResponseSnapshot + = + use response: HttpResponseMessage = + sendGetWithHeaders requestHeaders client url + |> await + + let responseHeaders = + Seq.append + (headerPairs response.Headers) + (headerPairs response.Content.Headers) + |> Seq.sortBy fst + |> List.ofSeq + + { StatusCode = response.StatusCode + Headers = responseHeaders + Body = response.Content.ReadAsByteArrayAsync() |> await } + +let private responseSnapshot + (client: HttpClient) + (url: string) + = + responseSnapshotWithHeaders [] client url + +let private iframeContentSnapshot + (client: HttpClient) + (url: string) + = + responseSnapshotWithHeaders + iframeNavigationHeaders + client + url + +let private configuration values = + values + |> Seq.map (fun (key, value) -> + KeyValuePair<string, string>(key, value)) + |> ConfigurationBuilder() + .AddInMemoryCollection + |> _.Build() + +[<TestFixture>] +[<Category("Unit")>] +[<Category("Fast")>] +type BlobStorageFailureTests() = + + [<TestCase(404, "BlobNotFound", true)>] + [<TestCase(404, "ContainerNotFound", false)>] + [<TestCase(403, "AuthorizationPermissionMismatch", false)>] + member _.``only a missing-blob response becomes not-found``( + status: int, + errorCode: string, + expected: bool + ) = + let failure = + RequestFailedException( + status, + "sensitive Azure diagnostics", + errorCode, + null + ) + + Assert.That( + BlobStorage.isMissingBlobFailure failure, + Is.EqualTo(expected) + ) + +[<TestFixture>] +[<Category("Unit")>] +[<Category("Fast")>] +type SharePathValidationTests() = + + [<Test>] + member _.``valid segments compose the exact blob name``() = + let path = + SharePath.tryCreate + validPrefix + "build-status.html" + + Assert.That(path |> Option.isSome, Is.True) + + Assert.That( + path |> Option.map SharePath.blobName, + Is.EqualTo( + Some + $"{validPrefix}/build-status.html" + ) + ) + + [<Test>] + member _.``prefix must be exactly 22 characters``() = + Assert.That( + SharePath.PrefixLength, + Is.EqualTo(Server.CanvasShare.PrefixLength) + ) + + Assert.That( + SharePath.tryCreate + "0123456789ABCDEFGHIJK" + "report.html" + |> Option.isNone, + Is.True + ) + + Assert.That( + SharePath.tryCreate + "0123456789ABCDEFGHIJKLM" + "report.html" + |> Option.isNone, + Is.True + ) + + [<Test>] + member _.``prefix accepts only ASCII base62``() = + Assert.That( + SharePath.tryCreate + "0123456789ABCDEFGHIJK_" + "report.html" + |> Option.isNone, + Is.True + ) + + Assert.That( + SharePath.tryCreate + "0123456789ABCDEFGHIJKé" + "report.html" + |> Option.isNone, + Is.True + ) + + [<TestCase("../report.html")>] + [<TestCase("folder/report.html")>] + [<TestCase(@"folder\report.html")>] + member _.``filename rejects traversal``(filename: string) = + Assert.That( + SharePath.tryCreate validPrefix filename + |> Option.isNone, + Is.True + ) + + [<TestCase("Status.HTML")>] + [<TestCase("release..notes.html")>] + member _.``filename accepts case-insensitive html suffix and consecutive dots``(filename: string) = + Assert.That( + SharePath.tryCreate validPrefix filename + |> Option.map SharePath.blobName, + Is.EqualTo(Some $"{validPrefix}/{filename}") + ) + + [<TestCase("")>] + [<TestCase("report.txt")>] + [<TestCase("report.html.txt")>] + member _.``filename must end with html``(filename: string) = + Assert.That( + SharePath.tryCreate validPrefix filename + |> Option.isNone, + Is.True + ) + +[<TestFixture>] +[<Category("Unit")>] +[<Category("Fast")>] +type ShareExpiryTests() = + + let expiresOn = + DateTimeOffset( + 2030, + 1, + 1, + 0, + 0, + 0, + TimeSpan.Zero + ) + + let metadata = + Map [ + ShareExpiry.MetadataKey, + formatExpiry expiresOn + ] + + [<Test>] + member _.``share is live only before its expiry``() = + Assert.Multiple(fun () -> + Assert.That( + ShareExpiry.isLive + (expiresOn.AddTicks(-1L)) + metadata, + Is.True, + "before expiry" + ) + + Assert.That( + ShareExpiry.isLive expiresOn metadata, + Is.False, + "at expiry" + ) + + Assert.That( + ShareExpiry.isLive + (expiresOn.AddTicks(1L)) + metadata, + Is.False, + "after expiry" + )) + + [<Test>] + member _.``ExpiresOn metadata is live through both share lookups``() = + let now = expiresOn.AddTicks(-1L) + let mixedCaseMetadata = + Map [ "ExpiresOn", formatExpiry expiresOn ] + let blobName = $"{validPrefix}/report.html" + let stored = document "shared document" mixedCaseMetadata + let fake = + fakeBlobReader (Map [ blobName, stored ]) + + let propertiesResult = + ShareLookup.resolveProperties + fake.Reader + (fun () -> now) + validPrefix + "report.html" + CancellationToken.None + |> await + + let documentResult = + ShareLookup.resolveDocument + fake.Reader + (fun () -> now) + validPrefix + "report.html" + CancellationToken.None + |> await + + use resolvedDocument = + match documentResult with + | Available document -> + document + | NotFound -> + Assert.Fail("Expected the live document lookup to succeed.") + Unchecked.defaultof<BlobDocument> + + Assert.Multiple(fun () -> + Assert.That( + ShareExpiry.isLive now mixedCaseMetadata, + Is.True + ) + + Assert.That( + propertiesResult, + Is.EqualTo( + Available mixedCaseMetadata + ) + ) + + Assert.That( + resolvedDocument.Metadata, + Is.EqualTo(mixedCaseMetadata) + ) + + Assert.That( + resolvedDocument.ContentLength, + Is.EqualTo(int64 stored.Content.LongLength) + ) + + Assert.That( + fake.Requests(), + Is.EqualTo( + [ + PropertiesLookup blobName + ContentRead blobName + ] + ) + )) + + [<Test>] + member _.``missing expiry metadata is malformed``() = + Assert.That( + ShareExpiry.isLive + (expiresOn.AddDays(-1.0)) + Map.empty, + Is.False + ) + + [<Test>] + member _.``unparseable expiry metadata is malformed``() = + Assert.That( + ShareExpiry.isLive + (expiresOn.AddDays(-1.0)) + (Map [ + ShareExpiry.MetadataKey, "tomorrow" + ]), + Is.False + ) + + [<Test>] + member _.``expiry must be canonical round-trip UTC``() = + let nonUtc = + expiresOn + .ToOffset(TimeSpan.FromHours(2.0)) + .ToString("o", CultureInfo.InvariantCulture) + + let nonCanonical = + expiresOn.ToString( + "yyyy-MM-dd'T'HH:mm:ssK", + CultureInfo.InvariantCulture + ) + + Assert.Multiple(fun () -> + Assert.That( + ShareExpiry.isLive + (expiresOn.AddDays(-1.0)) + (Map [ + ShareExpiry.MetadataKey, nonUtc + ]), + Is.False + ) + + Assert.That( + ShareExpiry.isLive + (expiresOn.AddDays(-1.0)) + (Map [ + ShareExpiry.MetadataKey, + nonCanonical + ]), + Is.False + )) + +[<TestFixture>] +[<Category("Unit")>] +[<Category("Fast")>] +type ViewerConfigurationTests() = + + [<Test>] + member _.``storage account and share container bind from viewer configuration``() = + let values = + [ + "CanvasShareViewer:StorageAccountName", + "storageacct" + "CanvasShareViewer:ShareContainer", + "canvas-shares" + ] + + match values |> configuration |> ViewerConfiguration.read with + | Ok loaded -> + Assert.Multiple(fun () -> + Assert.That( + loaded.StorageAccountName, + Is.EqualTo("storageacct") + ) + + Assert.That( + loaded.ShareContainer, + Is.EqualTo("canvas-shares") + )) + | Error error -> + Assert.Fail(error) + + [<TestCase("CanvasShareViewer:StorageAccountName")>] + [<TestCase("CanvasShareViewer:ShareContainer")>] + member _.``blank required viewer configuration is rejected``(blankKey: string) = + let values = + [ + "CanvasShareViewer:StorageAccountName", + "storageacct" + "CanvasShareViewer:ShareContainer", + "canvas-shares" + ] + |> List.map (fun (key, value) -> + key, + (if key = blankKey then " " else value)) + + Assert.That( + values + |> configuration + |> ViewerConfiguration.read + |> Result.isError, + Is.True + ) + +[<TestFixture>] +[<Category("Unit")>] +[<Category("Fast")>] +[<NonParallelizable>] +type ViewerRouteTests() = + + let now = + DateTimeOffset( + 2030, + 1, + 1, + 0, + 0, + 0, + TimeSpan.Zero + ) + + let liveMetadata = + Map [ + ShareExpiry.MetadataKey, + now.AddHours(1.0) |> formatExpiry + ] + + let assertDependencyFailure + environmentName + createError + expectedLogMessage + = + withThrowingViewer + environmentName + createError + now + (fun logs client baseUrl -> + let snapshots = + [ + ( + [], + $"{baseUrl}/c/{validPrefix}/report.html" + ) + ( + iframeNavigationHeaders, + $"{baseUrl}/c/{validPrefix}/report.html/content" + ) + ] + |> List.map (fun (headers, url) -> + responseSnapshotWithHeaders + headers + client + url) + + let expected = snapshots |> List.head + let errorLogs = + logs.Entries() + |> List.filter (fun entry -> + entry.Level = LogLevel.Error) + + Assert.Multiple(fun () -> + snapshots + |> List.iter (fun snapshot -> + Assert.That( + snapshot.StatusCode, + Is.EqualTo( + HttpStatusCode.ServiceUnavailable + ) + ) + + Assert.That( + snapshot.Headers, + Is.EqualTo( + expectedDependencyFailureHeaders + ) + ) + + Assert.That( + snapshot.Body, + Is.Empty, + "dependency failures must not expose diagnostics" + ) + + Assert.That( + snapshot, + Is.EqualTo(expected), + "shell and content routes must emit one fixed dependency-failure response" + )) + + Assert.That( + errorLogs |> List.length, + Is.EqualTo(2), + "each failed route must emit one safe dependency log" + ) + + errorLogs + |> List.iter (fun entry -> + Assert.That( + entry.Message, + Is.EqualTo(expectedLogMessage) + ) + + Assert.That( + entry.Exception, + Is.EqualTo(None: exn option), + "the logger must not receive the exception object or its diagnostics" + )))) + + [<Test>] + member _.``viewer maps exactly the two GET routes``() = + let fake = fakeBlobReader Map.empty + let builder = + WebApplication.CreateEmptyBuilder( + WebApplicationOptions() + ) + + builder.WebHost.UseKestrel() |> ignore + + use app = + ViewerApplication.create + builder + fake.Reader + (fun () -> now) + + let routes = + (app :> IEndpointRouteBuilder).DataSources + |> Seq.collect _.Endpoints + |> Seq.map (fun endpoint -> + let route = endpoint :?> RouteEndpoint + + let methods = + endpoint.Metadata + .GetMetadata<HttpMethodMetadata>() + .HttpMethods + |> List.ofSeq + + route.RoutePattern.RawText, methods) + |> List.ofSeq + + Assert.That( + routes, + Is.EquivalentTo( + [ + ViewerApplication.ShellRoute, + [ "GET" ] + ViewerApplication.ContentRoute, + [ "GET" ] + ] + ) + ) + + [<Test>] + member _.``shell uses properties while sandboxed content reads the body``() = + let filename = "report & \"notes\".html" + let encodedFilename = Uri.EscapeDataString(filename) + let blobName = $"{validPrefix}/{filename}" + let secretMarker = "document-body-secret-marker" + + let documents = + Map [ + blobName, + document + $"<html><body>{secretMarker}</body></html>" + liveMetadata + ] + + withViewer documents now (fun fake client baseUrl -> + use shell = + client.GetAsync( + $"{baseUrl}/c/{validPrefix}/{encodedFilename}" + ) + |> await + + let shellBody = + shell.Content.ReadAsStringAsync() |> await + + let shellDom = parseHtmlDom shellBody + + let iframe = + shellDom.Descendants(XName.Get("iframe")) + |> Seq.exactlyOne + + let sandboxTokens = + requiredAttribute "sandbox" iframe + |> _.Split( + ' ', + StringSplitOptions.RemoveEmptyEntries + ) + |> Set.ofArray + + use content = + getIframeContent + client + $"{baseUrl}/c/{validPrefix}/{encodedFilename}/content" + |> await + + let contentBody = + content.Content.ReadAsStringAsync() |> await + + Assert.Multiple(fun () -> + Assert.That( + shell.StatusCode, + Is.EqualTo(HttpStatusCode.OK) + ) + + Assert.That( + shellBody, + Does.Not.Contain(secretMarker), + "the shell must not carry document content" + ) + + Assert.That( + shellDom.Descendants(XName.Get("script")), + Is.Empty, + "the shell must expose no script API" + ) + + Assert.That( + requiredAttribute "src" iframe, + Is.EqualTo( + $"/c/{validPrefix}/{encodedFilename}/content" + ) + ) + + Assert.That( + sandboxTokens, + Is.EqualTo(Set.singleton "allow-scripts"), + "the iframe must omit same-origin, forms, popups, downloads, and top-navigation" + ) + + Assert.That( + iframe.Attribute(XName.Get("srcdoc")) + |> Option.ofObj + |> Option.isNone, + Is.True, + "the document must be loaded only from the content route" + ) + + Assert.That( + content.StatusCode, + Is.EqualTo(HttpStatusCode.OK) + ) + + Assert.That( + contentBody, + Does.Contain(secretMarker) + ) + + Assert.That( + fake.Requests(), + Is.EqualTo( + [ + PropertiesLookup blobName + ContentRead blobName + ] + ), + "the shell must read only properties and the content route must perform the only body read" + ))) + + [<Test>] + member _.``expired document lookup disposes the unread body stream``() = + let stream = + new DisposalTrackingStream( + Encoding.UTF8.GetBytes("expired") + ) + + let expiredMetadata = + Map [ + ShareExpiry.MetadataKey, + formatExpiry now + ] + + let reader = + { ReadPropertiesExact = + fun _ _ -> + Task.FromResult(None) + ReadExact = + fun _ _ -> + Task.FromResult( + Some + { Content = stream + ContentLength = stream.Length + Metadata = expiredMetadata } + ) } + + let result = + ShareLookup.resolveDocument + reader + (fun () -> now) + validPrefix + "report.html" + CancellationToken.None + |> await + + Assert.Multiple(fun () -> + Assert.That( + (match result with + | NotFound -> true + | Available _ -> false), + Is.True + ) + Assert.That(stream.IsDisposed, Is.True)) + + [<Test>] + member _.``content route fails closed to the shell without exact iframe Fetch Metadata``() = + let blobName = $"{validPrefix}/report.html" + let secretMarker = "active-document-secret-marker" + + let documents = + Map [ + blobName, + document + $"<html><body>{secretMarker}</body></html>" + liveMetadata + ] + + let rejectedMetadata = + [ + "missing", [] + "top-level", + [ + "Sec-Fetch-Site", "none" + "Sec-Fetch-Mode", "navigate" + "Sec-Fetch-Dest", "document" + ] + "partial", + [ + "Sec-Fetch-Site", "same-origin" + "Sec-Fetch-Mode", "navigate" + ] + "duplicated", + [ + "Sec-Fetch-Site", "same-origin" + "Sec-Fetch-Site", "same-origin" + "Sec-Fetch-Mode", "navigate" + "Sec-Fetch-Dest", "iframe" + ] + "cross-site iframe", + [ + "Sec-Fetch-Site", "cross-site" + "Sec-Fetch-Mode", "navigate" + "Sec-Fetch-Dest", "iframe" + ] + ] + + withViewer documents now (fun fake client baseUrl -> + let shellUrl = + $"{baseUrl}/c/{validPrefix}/report.html" + + let contentUrl = $"{shellUrl}/content" + let shell = responseSnapshot client shellUrl + + let fallbacks = + rejectedMetadata + |> List.map (fun (label, headers) -> + label, + responseSnapshotWithHeaders + headers + client + contentUrl) + + let active = + iframeContentSnapshot client contentUrl + + Assert.Multiple(fun () -> + fallbacks + |> List.iter (fun (label, fallback) -> + Assert.That( + fallback, + Is.EqualTo(shell), + $"{label} content navigation must receive the normal non-executable shell" + ) + + Assert.That( + fallback.Body + |> Encoding.UTF8.GetString, + Does.Not.Contain(secretMarker) + )) + + Assert.That( + active.StatusCode, + Is.EqualTo(HttpStatusCode.OK) + ) + + Assert.That( + active.Body + |> Encoding.UTF8.GetString, + Does.Contain(secretMarker), + "only the exact same-origin iframe navigation may receive active HTML" + ) + + Assert.That( + fake.Requests(), + Is.EqualTo( + (List.replicate + (rejectedMetadata.Length + 1) + (PropertiesLookup blobName)) + @ [ ContentRead blobName ] + ), + "every fallback must validate expiry independently without reading the body" + ))) + + [<Test>] + member _.``shell and content emit their exact response policies``() = + let blobName = $"{validPrefix}/report.html" + + let documents = + Map [ + blobName, + document + "<html><body>content</body></html>" + liveMetadata + ] + + withViewer documents now (fun _ client baseUrl -> + use shell = + client.GetAsync( + $"{baseUrl}/c/{validPrefix}/report.html" + ) + |> await + + use content = + getIframeContent + client + $"{baseUrl}/c/{validPrefix}/report.html/content" + |> await + + Assert.Multiple(fun () -> + Assert.That( + responseHeadersWithoutDate shell, + Is.EqualTo( + expectedPolicyHeaders + shellContentSecurityPolicy + ) + ) + + Assert.That( + responseHeadersWithoutDate content, + Is.EqualTo( + expectedPolicyHeaders + contentContentSecurityPolicy + ) + ) + + Assert.That( + shell.Content.Headers.ContentType + |> Option.ofObj + |> Option.map string, + Is.EqualTo( + Some "text/html; charset=utf-8" + ) + ) + + Assert.That( + content.Content.Headers.ContentType + |> Option.ofObj + |> Option.map string, + Is.EqualTo( + Some "text/html; charset=utf-8" + ) + ))) + + [<TestCase("Status.HTML")>] + [<TestCase("release..notes.html")>] + member _.``publisher-compatible filename works on shell and content routes``(filename: string) = + let encodedFilename = Uri.EscapeDataString(filename) + let blobName = $"{validPrefix}/{filename}" + let body = $"content for {filename}" + + let documents = + Map [ + blobName, + document body liveMetadata + ] + + withViewer documents now (fun fake client baseUrl -> + use shell = + client.GetAsync( + $"{baseUrl}/c/{validPrefix}/{encodedFilename}" + ) + |> await + + use content = + getIframeContent + client + $"{baseUrl}/c/{validPrefix}/{encodedFilename}/content" + |> await + + Assert.Multiple(fun () -> + Assert.That( + shell.StatusCode, + Is.EqualTo(HttpStatusCode.OK), + "shell route" + ) + + Assert.That( + content.StatusCode, + Is.EqualTo(HttpStatusCode.OK), + "content route" + ) + + Assert.That( + content.Content.ReadAsStringAsync() + |> await, + Is.EqualTo(body) + ) + + Assert.That( + fake.Requests(), + Is.EqualTo( + [ + PropertiesLookup blobName + ContentRead blobName + ] + ), + "both lookup kinds must preserve exact filename casing" + ))) + + [<TestCase("Production")>] + [<TestCase("Development")>] + member _.``storage failures return a fixed empty 503 in every environment``(environmentName: string) = + assertDependencyFailure + environmentName + (fun () -> + RequestFailedException( + 429, + "sensitive storage diagnostics", + "ServerBusy", + InvalidOperationException( + "sensitive inner diagnostics" + ) + )) + "Viewer dependency failure: ExceptionType=RequestFailedException; AzureStatus=429; AzureErrorCode=ServerBusy" + + [<TestCase("Production")>] + [<TestCase("Development")>] + member _.``credential failures return a fixed empty 503 in every environment``(environmentName: string) = + [ + (fun () -> + AuthenticationFailedException( + "sensitive authentication diagnostics", + RequestFailedException( + 403, + "sensitive Azure diagnostics", + "AuthenticationFailed", + null + ) + ) + :> exn), + "Viewer dependency failure: ExceptionType=AuthenticationFailedException; AzureStatus=403; AzureErrorCode=AuthenticationFailed" + (fun () -> + CredentialUnavailableException( + "sensitive credential diagnostics" + ) + :> exn), + "Viewer dependency failure: ExceptionType=CredentialUnavailableException; AzureStatus=unavailable; AzureErrorCode=unavailable" + ] + |> List.iter (fun (createError, expectedLogMessage) -> + assertDependencyFailure + environmentName + createError + expectedLogMessage) + + [<Test>] + member _.``content preserves a self-contained active document``() = + let blobName = $"{validPrefix}/self-contained.html" + let fixture = selfContainedFixtureBytes () + + let documents = + Map [ + blobName, + storedDocument fixture liveMetadata + ] + + withViewer documents now (fun _ client baseUrl -> + use response = + getIframeContent + client + $"{baseUrl}/c/{validPrefix}/self-contained.html/content" + |> await + + let actual = + response.Content.ReadAsByteArrayAsync() + |> await + + let dom = + actual + |> Encoding.UTF8.GetString + |> parseHtmlDom + + let style = + dom.Descendants(XName.Get("style")) + |> Seq.exactlyOne + + let script = + dom.Descendants(XName.Get("script")) + |> Seq.exactlyOne + + let image = + dom.Descendants(XName.Get("img")) + |> Seq.exactlyOne + + Assert.Multiple(fun () -> + Assert.That( + response.StatusCode, + Is.EqualTo(HttpStatusCode.OK) + ) + + Assert.That( + actual, + Is.EqualTo(fixture), + "the exported HTML must be streamed unchanged" + ) + + Assert.That( + style.Value, + Does.Contain("#execution-status") + ) + + Assert.That( + script.Value, + Does.Contain("window.eval(") + ) + + Assert.That( + script.Value, + Does.Contain("new Function(") + ) + + Assert.That( + requiredAttribute "src" image, + Does.StartWith("data:image/") + ))) + + [<Test>] + member _.``content response disposes its Blob stream after copying``() = + let bytes = + Encoding.UTF8.GetBytes( + "<html><body>streamed</body></html>" + ) + + let stream = new DisposalTrackingStream(bytes) + + let reader = + { ReadPropertiesExact = + fun _ _ -> + Task.FromResult(Some liveMetadata) + ReadExact = + fun _ _ -> + Task.FromResult( + Some + { Content = stream + ContentLength = int64 bytes.LongLength + Metadata = liveMetadata } + ) } + + let port = getFreeTcpPort () + let builder = + WebApplication.CreateEmptyBuilder( + WebApplicationOptions() + ) + builder.WebHost.UseKestrel(fun options -> + options.Listen(IPAddress.Loopback, port)) + |> ignore + + let app = + ViewerApplication.create + builder + reader + (fun () -> now) + + withRunningViewer app port (fun client baseUrl -> + use response = + getIframeContent + client + $"{baseUrl}/c/{validPrefix}/report.html/content" + |> await + + Assert.Multiple(fun () -> + Assert.That( + response.Content.ReadAsByteArrayAsync() + |> await, + Is.EqualTo(bytes) + ) + + Assert.That( + response.Content.Headers.ContentLength, + Is.EqualTo(int64 bytes.LongLength) + ))) + + Assert.That(stream.IsDisposed, Is.True) + + [<Test>] + member _.``all not-found outcomes are indistinguishable on both routes``() = + let missingName = $"{validPrefix}/missing.html" + let expiredName = $"{validPrefix}/expired.html" + let missingExpiryName = + $"{validPrefix}/missing-expiry.html" + let badExpiryName = + $"{validPrefix}/bad-expiry.html" + + let documents = + Map [ + expiredName, + document + "expired" + (Map [ + ShareExpiry.MetadataKey, + now |> formatExpiry + ]) + missingExpiryName, + document "missing expiry" Map.empty + badExpiryName, + document + "bad expiry" + (Map [ + ShareExpiry.MetadataKey, + "not-a-timestamp" + ]) + ] + + let cases = + [ + "short/report.html", [] + $"{validPrefix}/report.txt", [] + missingName, + [ + PropertiesLookup missingName + ContentRead missingName + PropertiesLookup missingName + ] + expiredName, + [ + PropertiesLookup expiredName + ContentRead expiredName + PropertiesLookup expiredName + ] + missingExpiryName, + [ + PropertiesLookup missingExpiryName + ContentRead missingExpiryName + PropertiesLookup missingExpiryName + ] + badExpiryName, + [ + PropertiesLookup badExpiryName + ContentRead badExpiryName + PropertiesLookup badExpiryName + ] + ] + + withViewer documents now (fun fake client baseUrl -> + let snapshots = + cases + |> List.map (fun (path, _) -> + responseSnapshot + client + $"{baseUrl}/c/{path}", + iframeContentSnapshot + client + $"{baseUrl}/c/{path}/content", + responseSnapshot + client + $"{baseUrl}/c/{path}/content") + + let expectedShell, expectedContent, _ = + snapshots |> List.head + + Assert.Multiple(fun () -> + snapshots + |> List.iter (fun (shell, content, fallback) -> + Assert.That( + shell, + Is.EqualTo(expectedShell) + ) + + Assert.That( + content, + Is.EqualTo(expectedContent) + ) + + Assert.That( + fallback, + Is.EqualTo(expectedShell), + "rejected content requests must preserve the shell not-found response" + ) + + Assert.That( + shell.StatusCode, + Is.EqualTo(HttpStatusCode.NotFound) + ) + + Assert.That( + content.StatusCode, + Is.EqualTo(HttpStatusCode.NotFound) + ) + + Assert.That( + fallback.StatusCode, + Is.EqualTo(HttpStatusCode.NotFound) + ) + + Assert.That( + shell.Body, + Is.Empty + ) + + Assert.That( + content.Body, + Is.Empty + ) + + Assert.That( + fallback.Body, + Is.Empty + )) + + Assert.That( + fake.Requests(), + Is.EqualTo( + cases + |> List.collect snd + ), + "malformed paths must skip storage while each valid path performs both independent properties checks and one body read" + ))) + + [<Test>] + member _.``viewer exposes no write or admin surface``() = + let blobName = $"{validPrefix}/report.html" + + let documents = + Map [ + blobName, + document "content" liveMetadata + ] + + withViewer documents now (fun _ client baseUrl -> + let writeRequests = + [ + HttpMethod.Post, + $"/c/{validPrefix}/report.html" + HttpMethod.Put, + $"/c/{validPrefix}/report.html/content" + HttpMethod.Delete, + $"/c/{validPrefix}/report.html" + HttpMethod.Post, "/upload" + HttpMethod.Delete, "/admin" + ] + + Assert.Multiple(fun () -> + writeRequests + |> List.iter (fun (method, path) -> + use request = + new HttpRequestMessage( + method, + $"{baseUrl}{path}" + ) + + use response = + client.SendAsync(request) |> await + + Assert.That( + int response.StatusCode, + Is.GreaterThanOrEqualTo(400), + $"{method} {path}" + )))) diff --git a/src/Tests/Tests.fsproj b/src/Tests/Tests.fsproj index 3e618d9b..a62eff5f 100644 --- a/src/Tests/Tests.fsproj +++ b/src/Tests/Tests.fsproj @@ -101,6 +101,9 @@ <Compile Include="HttpSecurityTests.fs" /> <Compile Include="CanvasExportTests.fs" /> <Compile Include="CanvasShareTests.fs" /> + <Compile Include="CanvasShareViewerTests.fs" /> + <Compile Include="CanvasShareViewerContainmentTestHelpers.fs" /> + <Compile Include="CanvasShareViewerContainmentTests.fs" /> <Compile Include="SmokeTests.fs" /> </ItemGroup> @@ -117,6 +120,7 @@ </ItemGroup> <ItemGroup> + <ProjectReference Include="..\CanvasShareViewer\CanvasShareViewer.fsproj" /> <ProjectReference Include="..\Server\Server.fsproj" /> <ProjectReference Include="..\Client\Client.fsproj" /> <ProjectReference Include="..\Cli\Cli.fsproj" /> diff --git a/src/Tests/fixtures/canvas-share-viewer/hostile.html b/src/Tests/fixtures/canvas-share-viewer/hostile.html new file mode 100644 index 00000000..183cf981 --- /dev/null +++ b/src/Tests/fixtures/canvas-share-viewer/hostile.html @@ -0,0 +1,138 @@ +<!doctype html> +<html> +<head> + <meta charset="utf-8" /> + <title>Hostile viewer containment fixture + + + + 
starting
+ + + diff --git a/src/Tests/fixtures/canvas-share-viewer/self-contained.html b/src/Tests/fixtures/canvas-share-viewer/self-contained.html new file mode 100644 index 00000000..32467c33 --- /dev/null +++ b/src/Tests/fixtures/canvas-share-viewer/self-contained.html @@ -0,0 +1,28 @@ + + + + + Self-contained viewer fixture + + + +
ready
+ embedded pixel +
+ Show native disclosure +

Disclosure content

+
+ + + diff --git a/src/Tests/fixtures/canvas-share-viewer/self-navigation.html b/src/Tests/fixtures/canvas-share-viewer/self-navigation.html new file mode 100644 index 00000000..f3c53934 --- /dev/null +++ b/src/Tests/fixtures/canvas-share-viewer/self-navigation.html @@ -0,0 +1,41 @@ + + + + + Viewer self-navigation containment fixture + + + + + + diff --git a/treemon.slnx b/treemon.slnx index e73620e2..3b2c7b93 100644 --- a/treemon.slnx +++ b/treemon.slnx @@ -1,5 +1,6 @@ +