@reventlessdev/reventless-aws 3.0.0-alpha.253 → 3.0.0-alpha.254

package/src/adapter/Upload/Upload_Claim_S3_Ops.res

@@ -0,0 +1,279 @@
+// Runtime handler for the upload claim component — compiled, type-checked and
+// Pulumi-free so it ships as an EntryPoint module (`Upload_Claim_S3` bundles it
+// and attaches it to every ref-bearing event log's stream).
+//
+// It answers one question per committed event: has anything now referenced this
+// uploaded object? If so the object stops being provisional, and the pending
+// tag the mint side wrote comes off. An object nobody ever references keeps its
+// tag, and a lifecycle rule — opt-in, and only once reconciliation has confirmed
+// the tagged set is the unreferenced set — expires it.
+//
+// Triggered by DynamoDB streams over the event log tables, one shared Lambda for
+// the whole platform: routing is per record via `CLAIM_REF_FIELDS`, keyed by the
+// table name in `eventSourceARN`, exactly as `StateTopic_AppSync_Ops` routes its
+// own shared Lambda. The event log row is `{event: "<Type>", data: {…}}`, so a
+// row without an `event` attribute — a snapshot, a DCB fence row — is not an
+// event and drops out before anything else runs.
+//
+// Four properties this needs, and one it deliberately does not:
+//
+//   Idempotent    untagging an untagged object, or one that is gone, is
+//                 success. Replays and at-least-once delivery are non-events.
+//   Scoped        it only ever touches keys under a declared store's served
+//                 prefix; a ref pointing anywhere else is refused, not guessed.
+//   Observable    lag is the one failure mode that deletes data, so the ESM's
+//                 `IteratorAge` is alarmed at deploy time (see `Upload_Claim_S3`).
+//   Narrow        its input is only event logs with a declared ref field. It is
+//                 not a projection and must not grow into one.
+//   Not ordered   the object exists before the event that references it — the
+//                 PUT precedes the command — so there is no race to design for,
+//                 and no consistent read is needed.
+//
+// Failure direction, deliberately: anything this handler cannot do leaves the
+// tag on. A tag left behind delays nothing except an eventual expiry that is
+// off by default; a tag wrongly removed is only ever a missed cleanup. The one
+// unsafe direction — a claim that never runs while the rule is on — is what the
+// lag alarm and the opt-in sequencing exist for.
+
+module S3 = AwsSdk.S3
+
+// ── Environment ─────────────────────────────────────────────────────────────
+
+let getEnv = (k: string): option<string> =>
+  switch NodeProcess.env->Dict.get(k) {
+  | Some("") | None => None
+  | Some(v) => Some(v)
+  }
+
+let parseEnvObject = (k: string): dict<JSON.t> =>
+  switch getEnv(k)->Option.map(s => JSON.parseOrThrow(s)) {
+  | Some(Object(obj)) => obj
+  | _ => Dict.make()
+  }
+
+/** A store the claimer may untag in: its physical bucket and the prefix its keys
+    are rooted at. Same `UPLOAD_STORES` shape the presign service reads, keyed by
+    the qualified `{plugin}.{store}` name a declaration resolves to. */
+type storeConfig = {
+  bucket: string,
+  prefix: string,
+}
+
+let decodeStore = (json: JSON.t): option<storeConfig> =>
+  switch json {
+  | Object(obj) =>
+    switch (
+      obj->Dict.get("bucket")->Option.flatMap(JSON.Decode.string),
+      obj->Dict.get("prefix")->Option.flatMap(JSON.Decode.string),
+    ) {
+    | (Some(bucket), Some(prefix)) => Some({bucket, prefix})
+    | _ => None
+    }
+  | _ => None
+  }
+
+let stores: dict<storeConfig> =
+  parseEnvObject("UPLOAD_STORES")
+  ->Dict.toArray
+  ->Array.filterMap(((k, v)) => decodeStore(v)->Option.map(c => (k, c)))
+  ->Dict.fromArray
+
+/** One declared ref-bearing field, as `StorageRefFields.toJson` wrote it. */
+type refField = {
+  field: string,
+  many: bool,
+  store: string,
+}
+
+let decodeRefField = (json: JSON.t): option<refField> =>
+  switch json {
+  | Object(obj) =>
+    switch (
+      obj->Dict.get("field")->Option.flatMap(JSON.Decode.string),
+      obj->Dict.get("store")->Option.flatMap(JSON.Decode.string),
+    ) {
+    | (Some(field), Some(store)) =>
+      Some({
+        field,
+        many: obj->Dict.get("arity")->Option.flatMap(JSON.Decode.string) == Some("many"),
+        store,
+      })
+    | _ => None
+    }
+  | _ => None
+  }
+
+let decodeEventFields = (json: JSON.t): dict<array<refField>> =>
+  switch json {
+  | Object(obj) =>
+    obj
+    ->Dict.toArray
+    ->Array.map(((eventType, v)) => (
+      eventType,
+      switch v {
+      | Array(items) => items->Array.filterMap(decodeRefField)
+      | _ => []
+      },
+    ))
+    ->Dict.fromArray
+  | _ => Dict.make()
+  }
+
+/** `{ "<eventLogTableName>": { "<eventType>": [refField] } }`, baked at deploy
+    time from the plugins' `@storageRef` declarations. Its keys are the whole of
+    this component's input: a table absent from the map is a table it never
+    reads a record from. */
+let refFieldsByTable: dict<dict<array<refField>>> =
+  parseEnvObject("CLAIM_REF_FIELDS")
+  ->Dict.toArray
+  ->Array.map(((table, v)) => (table, decodeEventFields(v)))
+  ->Dict.fromArray
+
+// ── Pure derivations ────────────────────────────────────────────────────────
+
+/** Table name out of a stream ARN — `…:table/<TableName>/stream/<ts>`. */
+let tableNameFromEventSourceArn = (arn: string): option<string> => {
+  let parts = arn->String.split("/")
+  switch (parts->Array.get(0), parts->Array.get(1), parts->Array.get(2)) {
+  | (Some(prefix), Some(tableName), Some("stream")) if prefix->String.endsWith(":table") =>
+    Some(tableName)
+  | _ => None
+  }
+}
+
+/** The ref strings a declared field holds in one event payload.
+
+    Non-string values and the `""` sentinel (which `StorageRef` admits to mean
+    "no object") yield nothing, so a field that is present but empty costs no
+    S3 call. */
+let refsOfField = (~data: dict<JSON.t>, field: refField): array<string> =>
+  switch data->Dict.get(field.field) {
+  | Some(String(ref)) if !field.many && ref != "" => [ref]
+  | Some(Array(items)) if field.many =>
+    items->Array.filterMap(v =>
+      switch v {
+      | String(ref) if ref != "" => Some(ref)
+      | _ => None
+      }
+    )
+  | _ => []
+  }
+
+/** Strip the leading `/` a ref carries (`/{prefix}/{key}`) to recover the S3
+    object key. Mirrors the presign service, which mints `/${key}`. */
+let keyOfRef = (storageRef: string): string =>
+  storageRef->String.startsWith("/")
+    ? storageRef->String.slice(~start=1, ~end=storageRef->String.length)
+    : storageRef
+
+/** An object this claim may touch: a declared store, and a key that actually
+    sits under that store's served prefix.
+
+    The prefix check is the same one the release rule makes, for the same
+    reason — a ref that resolves outside the store it names is refused rather
+    than acted on, so a malformed or hostile ref cannot steer an untag at an
+    object the declaration does not cover. */
+type target = {
+  bucket: string,
+  key: string,
+}
+
+let resolveTarget = (~store: string, ~storageRef: string): result<target, string> =>
+  switch stores->Dict.get(store) {
+  | None => Error(`unknown_store ${store}`)
+  | Some({bucket, prefix}) =>
+    let key = storageRef->keyOfRef
+    key->String.startsWith(`${prefix}/`)
+      ? Ok({bucket, key})
+      : Error(`not_in_store ${store} ${storageRef}`)
+  }
+
+// ── The claim ───────────────────────────────────────────────────────────────
+
+/** Remove the pending tag, keeping every other tag the object carries.
+    Read-then-write rather than `DeleteObjectTagging`, which would take a
+    deployment's own tags with it.
+
+    Returns without writing when the tag is already absent — the replay case,
+    and the common one — so a redelivered batch costs one read per object and
+    no write. A missing object is success for the same reason a missing object
+    is a successful release: the outcome asked for has already happened. */
+let claim = async (~bucket: string, ~key: string): unit =>
+  try {
+    let current = await S3.GetObjectTaggingCommand.send(
+      S3.GetObjectTaggingCommand.make({bucket, key}),
+    )
+    let tagSet = current.tagSet->Option.getOr([])
+    let remaining = tagSet->Array.filter(t => t.key != Upload_PendingTag.key)
+    if remaining->Array.length != tagSet->Array.length {
+      let _ = await S3.PutObjectTaggingCommand.send(
+        S3.PutObjectTaggingCommand.make({bucket, key, tagging: {tagSet: remaining}}),
+      )
+    }
+  } catch {
+  | exn =>
+    switch exn->JsExn.fromException->Option.flatMap(JsExn.name) {
+    | Some("NoSuchKey") | Some("NotFound") => ()
+    | _ => throw(exn)
+    }
+  }
+
+// ── DynamoDB stream event (only the fields this handler reads) ──────────────
+
+type attributeValue = AwsSdk.DynamoDb.Util.attributeValue
+type streamRecord = {@as("NewImage") newImage?: dict<attributeValue>}
+type record = {
+  eventName: string,
+  eventSourceARN: string,
+  dynamodb?: streamRecord,
+}
+type event = {@as("Records") records: array<record>}
+
+/** The refs one stream record claims, already resolved to a bucket and key.
+
+    Pure and separately testable: everything between "a row appeared" and "an
+    S3 call happens" is decided here, so the untag itself has no branching left
+    in it. */
+let targetsOfRecord = (record: record): array<target> =>
+  switch (
+    record.eventSourceARN->tableNameFromEventSourceArn->Option.flatMap(t => refFieldsByTable->Dict.get(t)),
+    record.dynamodb->Option.flatMap(d => d.newImage),
+  ) {
+  | (Some(byEventType), Some(image)) =>
+    let row = AwsSdk.DynamoDb_Util_Helpers.unmarshallDict(image)
+    // No `event` attribute → not an event row (a snapshot, a DCB fence row).
+    switch (row->Dict.get("event")->Option.flatMap(JSON.Decode.string), row->Dict.get("data")) {
+    | (Some(eventType), Some(JSON.Object(data))) =>
+      byEventType
+      ->Dict.get(eventType)
+      ->Option.getOr([])
+      ->Array.flatMap(field =>
+        refsOfField(~data, field)->Array.filterMap(storageRef =>
+          switch resolveTarget(~store=field.store, ~storageRef) {
+          | Ok(target) => Some(target)
+          | Error(why) =>
+            // Refused, not acted on — and said out loud, because a ref that
+            // does not resolve is a declaration and a deploy disagreeing.
+            Console.error2("Upload_Claim: refusing ref outside a declared store —", why)
+            None
+          }
+        )
+      )
+    | _ => []
+    }
+  | _ => []
+  }
+
+// ── Runtime handler ─────────────────────────────────────────────────────────
+
+let handler = async (event: event): unit => {
+  // An append-only log only ever inserts events; MODIFY rows are fence and
+  // snapshot updates, which `targetsOfRecord` would drop anyway.
+  let targets = event.records->Array.filter(r => r.eventName == "INSERT")->Array.flatMap(targetsOfRecord)
+  // Sequential: a batch carries a handful of refs at most, and a failure must
+  // reach the ESM as a throw so the record is retried rather than silently
+  // leaving an object tagged.
+  await targets->Array.reduce(Promise.resolve(), (acc, {bucket, key}) =>
+    acc->Promise.then(_ => claim(~bucket, ~key))
+  )
+}

package/src/adapter/Upload/Upload_Claim_S3_Ops.res.mjs

@@ -0,0 +1,261 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as S3$AwsSdk from "@reventlessdev/rescript-aws-sdk/src/S3.res.mjs";
+import * as Stdlib_JSON from "@rescript/runtime/lib/es6/Stdlib_JSON.js";
+import * as Stdlib_Array from "@rescript/runtime/lib/es6/Stdlib_Array.js";
+import * as Stdlib_JsExn from "@rescript/runtime/lib/es6/Stdlib_JsExn.js";
+import * as Stdlib_Option from "@rescript/runtime/lib/es6/Stdlib_Option.js";
+import * as Primitive_object from "@rescript/runtime/lib/es6/Primitive_object.js";
+import * as ClientS3 from "@aws-sdk/client-s3";
+import * as Primitive_exceptions from "@rescript/runtime/lib/es6/Primitive_exceptions.js";
+import * as DynamoDb_Util_Helpers$AwsSdk from "@reventlessdev/rescript-aws-sdk/src/DynamoDb_Util_Helpers.res.mjs";
+import * as Upload_PendingTag$ReventlessAws from "./Upload_PendingTag.res.mjs";
+
+function getEnv(k) {
+  let v = process.env[k];
+  if (v !== undefined && v !== "") {
+    return v;
+  }
+}
+
+function parseEnvObject(k) {
+  let match = Stdlib_Option.map(getEnv(k), s => JSON.parse(s));
+  if (match !== undefined) {
+    if (typeof match === "object" && match !== null && !Array.isArray(match)) {
+      return match;
+    } else {
+      return {};
+    }
+  } else {
+    return {};
+  }
+}
+
+function decodeStore(json) {
+  if (typeof json !== "object" || json === null || Array.isArray(json)) {
+    return;
+  }
+  let match = Stdlib_Option.flatMap(json["bucket"], Stdlib_JSON.Decode.string);
+  let match$1 = Stdlib_Option.flatMap(json["prefix"], Stdlib_JSON.Decode.string);
+  if (match !== undefined && match$1 !== undefined) {
+    return {
+      bucket: match,
+      prefix: match$1
+    };
+  }
+}
+
+let stores = Object.fromEntries(Stdlib_Array.filterMap(Object.entries(parseEnvObject("UPLOAD_STORES")), param => {
+  let k = param[0];
+  return Stdlib_Option.map(decodeStore(param[1]), c => [
+    k,
+    c
+  ]);
+}));
+
+function decodeRefField(json) {
+  if (typeof json !== "object" || json === null || Array.isArray(json)) {
+    return;
+  }
+  let match = Stdlib_Option.flatMap(json["field"], Stdlib_JSON.Decode.string);
+  let match$1 = Stdlib_Option.flatMap(json["store"], Stdlib_JSON.Decode.string);
+  if (match !== undefined && match$1 !== undefined) {
+    return {
+      field: match,
+      many: Primitive_object.equal(Stdlib_Option.flatMap(json["arity"], Stdlib_JSON.Decode.string), "many"),
+      store: match$1
+    };
+  }
+}
+
+function decodeEventFields(json) {
+  if (typeof json === "object" && json !== null && !Array.isArray(json)) {
+    return Object.fromEntries(Object.entries(json).map(param => {
+      let v = param[1];
+      let tmp;
+      tmp = Array.isArray(v) ? Stdlib_Array.filterMap(v, decodeRefField) : [];
+      return [
+        param[0],
+        tmp
+      ];
+    }));
+  } else {
+    return {};
+  }
+}
+
+let refFieldsByTable = Object.fromEntries(Object.entries(parseEnvObject("CLAIM_REF_FIELDS")).map(param => [
+  param[0],
+  decodeEventFields(param[1])
+]));
+
+function tableNameFromEventSourceArn(arn) {
+  let parts = arn.split("/");
+  let match = parts[0];
+  let match$1 = parts[1];
+  let match$2 = parts[2];
+  if (match !== undefined && match$1 !== undefined && match$2 !== undefined && match$2 === "stream" && match.endsWith(":table")) {
+    return match$1;
+  }
+}
+
+function refsOfField(data, field) {
+  let match = data[field.field];
+  if (match === undefined) {
+    return [];
+  }
+  if (Array.isArray(match)) {
+    if (field.many) {
+      return Stdlib_Array.filterMap(match, v => {
+        if (typeof v === "string" && v !== "") {
+          return v;
+        }
+      });
+    } else {
+      return [];
+    }
+  }
+  switch (typeof match) {
+    case "string" :
+      if (!field.many && match !== "") {
+        return [match];
+      } else {
+        return [];
+      }
+    default:
+      return [];
+  }
+}
+
+function keyOfRef(storageRef) {
+  if (storageRef.startsWith("/")) {
+    return storageRef.slice(1, storageRef.length);
+  } else {
+    return storageRef;
+  }
+}
+
+function resolveTarget(store, storageRef) {
+  let match = stores[store];
+  if (match === undefined) {
+    return {
+      TAG: "Error",
+      _0: `unknown_store ` + store
+    };
+  }
+  let key = keyOfRef(storageRef);
+  if (key.startsWith(match.prefix + `/`)) {
+    return {
+      TAG: "Ok",
+      _0: {
+        bucket: match.bucket,
+        key: key
+      }
+    };
+  } else {
+    return {
+      TAG: "Error",
+      _0: `not_in_store ` + store + ` ` + storageRef
+    };
+  }
+}
+
+async function claim(bucket, key) {
+  try {
+    let current = await S3$AwsSdk.GetObjectTaggingCommand.send(new ClientS3.GetObjectTaggingCommand({
+      Bucket: bucket,
+      Key: key
+    }));
+    let tagSet = Stdlib_Option.getOr(current.TagSet, []);
+    let remaining = tagSet.filter(t => t.Key !== Upload_PendingTag$ReventlessAws.key);
+    if (remaining.length !== tagSet.length) {
+      await S3$AwsSdk.PutObjectTaggingCommand.send(new ClientS3.PutObjectTaggingCommand({
+        Bucket: bucket,
+        Key: key,
+        Tagging: {
+          TagSet: remaining
+        }
+      }));
+      return;
+    } else {
+      return;
+    }
+  } catch (raw_exn) {
+    let exn = Primitive_exceptions.internalToException(raw_exn);
+    let match = Stdlib_Option.flatMap(Stdlib_JsExn.fromException(exn), Stdlib_JsExn.name);
+    if (match !== undefined) {
+      switch (match) {
+        case "NoSuchKey" :
+        case "NotFound" :
+          return;
+        default:
+          throw exn;
+      }
+    } else {
+      throw exn;
+    }
+  }
+}
+
+function targetsOfRecord(record) {
+  let match = Stdlib_Option.flatMap(tableNameFromEventSourceArn(record.eventSourceARN), t => refFieldsByTable[t]);
+  let match$1 = Stdlib_Option.flatMap(record.dynamodb, d => d.NewImage);
+  if (match === undefined) {
+    return [];
+  }
+  if (match$1 === undefined) {
+    return [];
+  }
+  let row = DynamoDb_Util_Helpers$AwsSdk.unmarshallDict(undefined, match$1);
+  let match$2 = Stdlib_Option.flatMap(row["event"], Stdlib_JSON.Decode.string);
+  let match$3 = row["data"];
+  if (match$2 !== undefined) {
+    if (match$3 !== undefined) {
+      if (typeof match$3 === "object" && match$3 !== null && !Array.isArray(match$3)) {
+        return Stdlib_Option.getOr(match[match$2], []).flatMap(field => Stdlib_Array.filterMap(refsOfField(match$3, field), storageRef => {
+          let target = resolveTarget(field.store, storageRef);
+          if (target.TAG === "Ok") {
+            return target._0;
+          }
+          console.error("Upload_Claim: refusing ref outside a declared store —", target._0);
+        }));
+      } else {
+        return [];
+      }
+    } else {
+      return [];
+    }
+  } else {
+    return [];
+  }
+}
+
+async function handler(event) {
+  let targets = event.Records.filter(r => r.eventName === "INSERT").flatMap(targetsOfRecord);
+  return await Stdlib_Array.reduce(targets, Promise.resolve(), (acc, param) => {
+    let key = param.key;
+    let bucket = param.bucket;
+    return acc.then(() => claim(bucket, key));
+  });
+}
+
+let S3;
+
+export {
+  S3,
+  getEnv,
+  parseEnvObject,
+  decodeStore,
+  stores,
+  decodeRefField,
+  decodeEventFields,
+  refFieldsByTable,
+  tableNameFromEventSourceArn,
+  refsOfField,
+  keyOfRef,
+  resolveTarget,
+  claim,
+  targetsOfRecord,
+  handler,
+}
+/* stores Not a pure module */

package/src/adapter/Upload/Upload_PendingTag.res

@@ -0,0 +1,41 @@
+// The tag that makes "nobody has committed a reference to this object yet"
+// visible to S3 itself.
+//
+// One definition, three readers, and they must agree exactly or the mechanism
+// deletes live data:
+//   - the mint side writes it on the presigned PUT (`Upload_Presign_S3_Ops`),
+//   - the claim side removes it when a committed event carries the ref
+//     (`Upload_Claim_S3_Ops`),
+//   - the bucket's lifecycle rule expires what still carries it
+//     (`Capability_ObjectStore_S3`).
+// A rule filtered on a key the mint side never writes matches *nothing*, which
+// fails safe; a claim side that strips a different key leaves every object
+// tagged, which does not. Hence one module rather than three string literals.
+//
+// Runtime-pure and Pulumi-free on purpose: two of the three readers are Lambda
+// handlers shipped as EntryPoint modules, so a deploy-time import here would
+// leak `@pulumi/pulumi` into their cold-start graph.
+//
+// The tag's meaning is deliberately "not yet claimed", never "safe to delete".
+// Nothing reads it as permission; the lifecycle rule adds an age condition of
+// its own, and it is opt-in per store.
+
+/** Tag key. `:` is a legal S3 tag-key character, and the `reventless:` prefix
+    keeps the framework's tags from colliding with a deployment's own. */
+let key = "reventless:pending"
+
+/** Tag value. A single-valued tag: the key's presence is the fact, and the
+    value exists only because S3 tags are pairs. */
+let value = "true"
+
+/**
+The `Tagging` parameter of a `PutObject`, in the URL-encoded query-string form
+S3 specifies for that header.
+
+The colon is percent-encoded here because the value is parsed as a query string
+by S3, so its key/value separators are the only characters that may appear raw.
+The SDK hoists this into the presigned URL's query string (verified against a
+live bucket: a PUT that sends nothing but `Content-Type` still lands the tag),
+so the caller needs no cooperation and cannot opt out.
+*/
+let putObjectTagging = `${key->encodeURIComponent}=${value->encodeURIComponent}`

package/src/adapter/Upload/Upload_PendingTag.res.mjs

@@ -0,0 +1,15 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+
+let key = "reventless:pending";
+
+let value = "true";
+
+let putObjectTagging = encodeURIComponent(key) + `=` + encodeURIComponent(value);
+
+export {
+  key,
+  value,
+  putObjectTagging,
+}
+/* putObjectTagging Not a pure module */

package/src/adapter/Upload/Upload_Presign_S3.res

@@ -11,7 +11,7 @@
 // There is no Function URL and no anonymous surface: authentication is the platform
 // API's Cognito authorizer, and the verified caller identity reaches the handler in
 // the resolver payload (see the JS resolver code below). This is route B of
-// [docs/plans/upload-release-path.md]; the anonymous Function URL and the unverified
+// [docs/plans/done/upload-release-path.md]; the anonymous Function URL and the unverified
 // `decodeJwtSub` the mint side used to carry are gone.
 //
 // Why an EntryPoint and not a Pulumi `CallbackFunction`: the handler needs the AWS
@@ -106,6 +106,11 @@ let make = (
   // `GetObject` backs the `HeadObject` the age check reads. One Lambda covers every
   // declared store (route B1) — but its reach is still the union of those prefixes,
   // not a wildcard, so it cannot touch a key outside a declared store.
+  //
+  // `PutObjectTagging` is what lets the presigned PUT carry the pending tag: a
+  // presigned request runs with the *signer's* permissions, so tag-on-put fails
+  // with AccessDenied without it — and an untagged object is one the sweep can
+  // never reach.
   let _policy =
     resolvedStores->Pulumi.Output.apply(list => {
       let arns = list->Array.map(((_, bucket, prefix)) => `arn:aws:s3:::${bucket}/${prefix}/*`)
@@ -124,7 +129,12 @@ let make = (
               {
                 sid: "AllowUploadObjectAccess",
                 effect: Allow,
-                actions: Actions(["s3:PutObject", "s3:DeleteObject", "s3:GetObject"]),
+                actions: Actions([
+                  "s3:PutObject",
+                  "s3:PutObjectTagging",
+                  "s3:DeleteObject",
+                  "s3:GetObject",
+                ]),
                 resources: Resources(arns),
               },
             ],

package/src/adapter/Upload/Upload_Presign_S3.res.mjs

@@ -64,6 +64,7 @@ function make(api, stores, releaseWindowSecondsOpt, nameOpt, opts) {
           Effect: "Allow",
           Action: [
             "s3:PutObject",
+            "s3:PutObjectTagging",
             "s3:DeleteObject",
             "s3:GetObject"
           ],

package/src/adapter/Upload/Upload_Presign_S3_Ops.res

@@ -25,6 +25,7 @@ type putObjectInput = {
   @as("Bucket") bucket: string,
   @as("Key") key: string,
   @as("ContentType") contentType?: string,
+  @as("Tagging") tagging?: string,
 }
 type putObjectCommand
 
@@ -225,7 +226,18 @@ let handlePresign = async (
   // served prefix so the CloudFront `{prefix}/*` behavior fronts it, and namespaced
   // by the verified `sub` so the release rule can tell one caller's objects apart.
   let key = `${servedPrefix}/${sub}/${NodeCrypto.randomUUID()}/${fileName}`
-  let command = makePutObjectCommand({bucket, key, contentType: ?args.contentType})
+  // The object is provisional from the moment the bytes land: it carries the
+  // pending tag until a committed event referencing it strips it (see
+  // `Upload_Claim_S3_Ops`). Written into the signature here, not asked of the
+  // caller — the SDK hoists `x-amz-tagging` into the presigned URL's query
+  // string, so a client that PUTs exactly as it always has still gets tagged
+  // bytes, and cannot opt out.
+  let command = makePutObjectCommand({
+    bucket,
+    key,
+    contentType: ?args.contentType,
+    tagging: Upload_PendingTag.putObjectTagging,
+  })
   let uploadUrl = await getSignedUrl(client, command, {expiresIn: 300})
   // Same-origin relative ref `/{key}`: the served bucket is fronted read-only by the
   // UI's own CloudFront distribution under `{prefix}/*`, so a command stores this

package/src/adapter/Upload/Upload_Presign_S3_Ops.res.mjs

@@ -10,6 +10,7 @@ import * as Stdlib_JsError from "@rescript/runtime/lib/es6/Stdlib_JsError.js";
 import * as ClientS3 from "@aws-sdk/client-s3";
 import * as Primitive_exceptions from "@rescript/runtime/lib/es6/Primitive_exceptions.js";
 import * as S3RequestPresigner from "@aws-sdk/s3-request-presigner";
+import * as Upload_PendingTag$ReventlessAws from "./Upload_PendingTag.res.mjs";
 
 function getEnv(k) {
   let v = process.env[k];
@@ -175,7 +176,8 @@ async function handlePresign(client, bucket, servedPrefix, sub, args) {
   let command = new ClientS3.PutObjectCommand({
     Bucket: bucket,
     Key: key,
-    ContentType: args.contentType
+    ContentType: args.contentType,
+    Tagging: Upload_PendingTag$ReventlessAws.putObjectTagging
   });
   let uploadUrl = await S3RequestPresigner.getSignedUrl(client, command, {
     expiresIn: 300