Complete bounded browser and API product behavior

Dockerfile

@@ -1,3 +1,11 @@
+FROM node:24.18.0-bookworm-slim AS frontend
+
+WORKDIR /web
+COPY web/package.json web/package-lock.json ./
+RUN npm ci
+COPY web ./
+RUN npm test && npm run check && npm run build
+
 FROM haskell:9.10.3-slim-bookworm AS build
 
 RUN apt-get update \
@@ -40,6 +48,7 @@ RUN apt-get update \
 
 WORKDIR /app
 COPY sql ./sql
+COPY --from=frontend /web/dist ./web/dist
 USER 10001:10001
 
 FROM runtime-base AS test-runtime

Makefile

@@ -1,4 +1,4 @@
-.PHONY: test check-dependencies check-fixture-lib check-kind-matrix check-storage-foundation check-auth check-app check-streaming check-idempotency check-recovery check-protocol app-up app-down check-frontend build-frontend
+.PHONY: test check-dependencies check-fixture-lib check-kind-matrix check-storage-foundation check-auth check-app check-streaming check-idempotency check-recovery check-protocol check-product app-up app-down test-frontend check-frontend build-frontend
 
 test:
 	cabal test --offline nuthatch-unit
@@ -33,12 +33,18 @@ check-recovery:
 check-protocol:
 	./tests/kind/wp10-run.sh
 
+check-product: test-frontend check-frontend build-frontend
+	NUTHATCH_PRODUCT_GATE=1 ./tests/kind/wp05-run.sh
+
 app-up:
 	NUTHATCH_APP_INTERACTIVE=1 ./tests/kind/wp05-run.sh
 
 app-down:
 	./tests/kind/destroy.sh
 
+test-frontend:
+	npm --prefix web test
+
 check-frontend:
 	npm --prefix web run check
 

deploy/kubernetes/nuthatch.yaml.in

@@ -15,6 +15,10 @@ data:
   NUTHATCH_S3_REGION: "@@S3_REGION@@"
   NUTHATCH_S3_BUCKET: "@@S3_BUCKET@@"
   NUTHATCH_S3_PATH_STYLE: "true"
+  NUTHATCH_BROWSE_PAGE_SIZE: "200"
+  NUTHATCH_SEARCH_MAX_KEYS: "500"
+  NUTHATCH_SEARCH_TIMEOUT_MS: "2000"
+  NUTHATCH_DELETE_PAGE_SIZE: "100"
   NUTHATCH_IDEMPOTENCY_WINDOW_SEC: "86400"
   NUTHATCH_OBJECT_REQUEST_TIMEOUT_SEC: "300"
 ---

src/Nuthatch/Api.hs

@@ -3,6 +3,9 @@ module Nuthatch.Api
   , HealthEndpoint
   , ReadyEndpoint
   , BrowserScriptEndpoint
+  , AppEndpoint
+  , StaticAssetsEndpoint
+  , ProductApi
   , LoginEndpoint
   , LoginStart
   , OidcCallbackEndpoint
@@ -33,6 +36,12 @@ module Nuthatch.Api
   , DeleteRequest (..)
   , DeletePrefixRequest (..)
   , DeletePrefixResponse (..)
+  , SessionResponse (..)
+  , DeletePlanResponse (..)
+  , DeleteBatchItem (..)
+  , DeleteBatchRequest (..)
+  , DeleteItemResponse (..)
+  , DeleteBatchResponse (..)
   , UploadResponse (..)
   , DeleteResponse (..)
   , Throws
@@ -296,6 +305,7 @@ instance ToJSON BrowseError where
 data DownloadError
   = DownloadObjectStoreFailed Text
   | DownloadNotFound
+  | DownloadRangeUnsupported
   | DownloadThrottleUnavailable
   | DownloadBandwidthExceeded
   deriving stock (Eq, Show)
@@ -305,6 +315,8 @@ instance ToJSON DownloadError where
     errorValue "object_store_error" message Nothing
   toJSON DownloadNotFound =
     errorValue "not_found" "object not found" Nothing
+  toJSON DownloadRangeUnsupported =
+    errorValue "range_not_supported" "Range downloads are not supported" Nothing
   toJSON DownloadThrottleUnavailable =
     errorValue "throttle_unavailable" "bandwidth throttle unavailable" Nothing
   toJSON DownloadBandwidthExceeded =
@@ -361,6 +373,82 @@ instance ToJSON DeletePrefixError where
   toJSON (DeletePrefixMutationRejected message) =
     errorValue "prefix_mutation_rejected" message Nothing
 
+data SessionResponse = SessionResponse
+  { sessionResponseUserId  :: UserId
+  , sessionResponseDisplay :: Maybe Text
+  , sessionResponseCsrf    :: CsrfToken
+  }
+  deriving stock (Eq, Show)
+
+instance ToJSON SessionResponse where
+  toJSON response = object
+    [ "user_id" .= sessionResponseUserId response
+    , "display" .= sessionResponseDisplay response
+    , "csrf" .= sessionResponseCsrf response
+    ]
+
+data DeletePlanResponse = DeletePlanResponse
+  { deletePlanPaths        :: [RelativePath]
+  , deletePlanContinuation :: Maybe PaginationToken
+  }
+  deriving stock (Eq, Show)
+
+instance ToJSON DeletePlanResponse where
+  toJSON response = object
+    [ "paths" .= map unRelativePath (deletePlanPaths response)
+    , "continuation" .= deletePlanContinuation response
+    ]
+
+data DeleteBatchItem = DeleteBatchItem
+  { deleteBatchPath        :: RelativePath
+  , deleteBatchOperationId :: OperationId
+  }
+  deriving stock (Eq, Show)
+
+instance FromJSON DeleteBatchItem where
+  parseJSON = withObject "DeleteBatchItem" $ \o ->
+    DeleteBatchItem
+      <$> o .: "path"
+      <*> o .: "operation_id"
+
+data DeleteBatchRequest = DeleteBatchRequest
+  { deleteBatchRoot  :: Root
+  , deleteBatchCsrf  :: CsrfToken
+  , deleteBatchItems :: [DeleteBatchItem]
+  }
+  deriving stock (Eq, Show)
+
+instance FromJSON DeleteBatchRequest where
+  parseJSON = withObject "DeleteBatchRequest" $ \o ->
+    DeleteBatchRequest
+      <$> o .: "root"
+      <*> o .: "csrf"
+      <*> o .: "items"
+
+data DeleteItemResponse = DeleteItemResponse
+  { deleteItemPath        :: RelativePath
+  , deleteItemOperationId :: OperationId
+  , deleteItemResult      :: Maybe MutationResult
+  , deleteItemError       :: Maybe Text
+  }
+  deriving stock (Eq, Show)
+
+instance ToJSON DeleteItemResponse where
+  toJSON response = object
+    [ "path" .= unRelativePath (deleteItemPath response)
+    , "operation_id" .= deleteItemOperationId response
+    , "result" .= fmap mutationResultText (deleteItemResult response)
+    , "error" .= deleteItemError response
+    ]
+
+newtype DeleteBatchResponse = DeleteBatchResponse
+  { deleteBatchResults :: [DeleteItemResponse]
+  }
+  deriving stock (Eq, Show)
+
+instance ToJSON DeleteBatchResponse where
+  toJSON response = object ["results" .= deleteBatchResults response]
+
 errorValue :: Text -> Text -> Maybe Value -> Value
 errorValue code message details = object
   [ "error" .= code
@@ -377,6 +465,19 @@ type ReadyEndpoint =
 type BrowserScriptEndpoint =
   "nuthatch.js" :> Get '[JavaScript] BrowserScript
 
+type AppEndpoint =
+  "app"
+    :> AuthProtect SessionAuth
+    :> Throws AuthenticationError
+    :> Get '[HTML]
+      (Headers '[Header "Content-Security-Policy" Text] HtmlPage)
+
+type StaticAssetsEndpoint =
+  "assets"
+    :> AuthProtect SessionAuth
+    :> Throws AuthenticationError
+    :> Raw
+
 type LoginStart =
   Headers
     '[ Header "Set-Cookie" Text
@@ -437,6 +538,7 @@ type DownloadSuccess =
   Headers
     '[ Header "Content-Disposition" Text
      , Header "X-Content-Type-Options" Text
+     , Header "Content-Security-Policy" Text
      , Header "Content-Length" Integer
      ]
     (SourceIO BS.ByteString)
@@ -448,6 +550,7 @@ type DownloadEndpoint =
     :> Throws DownloadError
     :> QueryParam' '[Required, Strict] "root" Root
     :> QueryParam' '[Required, Strict] "path" RelativePath
+    :> Header "Range" Text
     :> StreamGet NoFraming OctetStream DownloadSuccess
 
 type UploadEndpoint =
@@ -480,10 +583,69 @@ type DeletePrefixEndpoint =
     :> ReqBody '[JSON] DeletePrefixRequest
     :> Post '[JSON] DeletePrefixResponse
 
+type ProductApi =
+  "api" :>
+    (    "session"
+           :> AuthProtect SessionAuth
+           :> Throws AuthenticationError
+           :> Get '[JSON] SessionResponse
+    :<|> "browse"
+           :> AuthProtect SessionAuth
+           :> Throws AuthenticationError
+           :> Throws BrowseError
+           :> QueryParam "root" Root
+           :> QueryParam "prefix" BrowsePrefix
+           :> QueryParam "q" SearchQuery
+           :> QueryParam "continuation" PaginationToken
+           :> Get '[JSON] BrowseView
+    :<|> "download"
+           :> AuthProtect SessionAuth
+           :> Throws AuthenticationError
+           :> Throws DownloadError
+           :> QueryParam' '[Required, Strict] "root" Root
+           :> QueryParam' '[Required, Strict] "path" RelativePath
+           :> Header "Range" Text
+           :> StreamGet NoFraming OctetStream DownloadSuccess
+    :<|> "upload"
+           :> AuthProtect SessionAuth
+           :> Throws AuthenticationError
+           :> Throws UploadError
+           :> QueryParam' '[Required, Strict] "root" Root
+           :> QueryParam' '[Required, Strict] "path" RelativePath
+           :> QueryParam' '[Required, Strict] "operation_id" OperationId
+           :> Header' '[Required, Strict] "X-Declared-Size" DeclaredSize
+           :> Header' '[Required, Strict] "X-Content-SHA256" ContentSha256
+           :> Header' '[Required, Strict] "X-CSRF-Token" CsrfToken
+           :> StreamBody NoFraming OctetStream (SourceIO BS.ByteString)
+           :> Post '[JSON] UploadResponse
+    :<|> "delete"
+           :> AuthProtect SessionAuth
+           :> Throws AuthenticationError
+           :> Throws DeleteError
+           :> ReqBody '[JSON] DeleteRequest
+           :> Post '[JSON] DeleteResponse
+    :<|> "delete-plan"
+           :> AuthProtect SessionAuth
+           :> Throws AuthenticationError
+           :> Throws DeletePrefixError
+           :> QueryParam' '[Required, Strict] "root" Root
+           :> QueryParam' '[Required, Strict] "path" RelativePath
+           :> QueryParam "continuation" PaginationToken
+           :> Get '[JSON] DeletePlanResponse
+    :<|> "delete-batch"
+           :> AuthProtect SessionAuth
+           :> Throws AuthenticationError
+           :> Throws DeletePrefixError
+           :> ReqBody '[JSON] DeleteBatchRequest
+           :> Post '[JSON] DeleteBatchResponse
+    )
+
 type Api =
        HealthEndpoint
   :<|> ReadyEndpoint
   :<|> BrowserScriptEndpoint
+  :<|> AppEndpoint
+  :<|> StaticAssetsEndpoint
   :<|> LoginEndpoint
   :<|> OidcCallbackEndpoint
   :<|> LogoutEndpoint
@@ -492,6 +654,7 @@ type Api =
   :<|> UploadEndpoint
   :<|> DeleteEndpoint
   :<|> DeletePrefixEndpoint
+  :<|> ProductApi
 
 api :: Proxy Api
 api = Proxy

src/Nuthatch/App.hs

@@ -6,6 +6,7 @@ module Nuthatch.App
   , authenticationHandler
   , loginResponse
   , dispatchAndFinalize
+  , collectKeysBoundedWith
   , PutFailure (..)
   , runPut
   , runDelete
@@ -19,29 +20,36 @@ import           Control.Exception
   , throwIO
   , try
   )
-import           Control.Monad (forever, when)
+import           Control.Monad (forM, forever, when)
 import           Control.Monad.IO.Class (liftIO)
 import           Control.Retry
   ( retrying )
 import qualified Data.Aeson as A
+import           Data.Bifunctor (first)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
 import           Data.Either (isRight)
-import           Data.Maybe (fromMaybe, listToMaybe)
+import           Data.Maybe (fromMaybe)
 import           Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
-import           Data.UUID (toText)
+import qualified Data.Text.IO as TIO
-import           Data.UUID.V4 (nextRandom)
+import           Data.Word (Word64)
 import           Database.PostgreSQL.Simple (Only (..))
+import           GHC.Clock (getMonotonicTimeNSec)
 import           Network.HTTP.Types
   ( hContentType
   , hCookie
   , hLocation
+  , methodGet
+  , status200
   , status400
+  , status404
+  , status405
   , urlDecode
   )
-import           Network.Wai (Request (..), responseLBS)
+import qualified Network.HTTP.Types.URI as URI
+import           Network.Wai (Request (..), responseFile, responseLBS)
 import           Nuthatch.Api
 import           Nuthatch.Audit (audit)
 import           Nuthatch.Config (Config (..))
@@ -82,13 +90,14 @@ import           Nuthatch.Streaming
   , UploadStreamError (..)
   )
 import           Nuthatch.Types
-import           Nuthatch.Ui (browsePage, browserScript)
+import           Nuthatch.Ui (browserScript, productPage)
 import           Servant
 import           Servant.Server.Experimental.Auth
   ( AuthHandler
   , mkAuthHandler
   )
 import           Servant.Types.SourceT (SourceT)
+import           System.Directory (doesFileExist)
 import           System.Timeout (timeout)
 import           Web.Cookie
   ( defaultSetCookie
@@ -145,6 +154,8 @@ server env =
        pure (HealthResponse True)
   :<|> handleReady env
   :<|> pure (BrowserScript browserScript)
+  :<|> handleAppRequest
+  :<|> staticAssetsServer
   :<|> handleLoginRequest env
   :<|> handleOidcCallback env
   :<|> handleLogoutRequest env
@@ -153,6 +164,78 @@ server env =
   :<|> handleUploadRequest env
   :<|> handleDeleteRequest env
   :<|> handleDeletePrefixRequest env
+  :<|>
+    (    handleSessionRequest
+    :<|> handleBrowseRequest env
+    :<|> handleDownloadRequest env
+    :<|> handleUploadRequest env
+    :<|> handleDeleteRequest env
+    :<|> handleDeletePlanRequest env
+    :<|> handleDeleteBatchRequest env
+    )
+
+handleAppRequest
+  :: SessionContext
+  -> Handler (Headers '[Header "Content-Security-Policy" Text] HtmlPage)
+handleAppRequest _ = do
+  page <- liftIO (TIO.readFile "web/dist/index.html")
+  pure (addHeader applicationContentSecurityPolicy (HtmlPage page))
+
+handleSessionRequest :: SessionContext -> Handler SessionResponse
+handleSessionRequest session =
+  case sessionCsrf session of
+    Nothing -> throwOperationError err403 AuthenticationRequired
+    Just csrf ->
+      let user = sessionUser session
+      in pure SessionResponse
+        { sessionResponseUserId = suUserId user
+        , sessionResponseDisplay = suDisplay user
+        , sessionResponseCsrf = csrf
+        }
+
+applicationContentSecurityPolicy :: Text
+applicationContentSecurityPolicy =
+  "default-src 'none'; script-src 'self'; style-src 'self'; connect-src 'self'; \
+  \base-uri 'none'; form-action 'self'; frame-ancestors 'none'; object-src 'none'"
+
+staticAssetsServer :: SessionContext -> Server Raw
+staticAssetsServer _ =
+  Tagged $ \request sendResponse ->
+    case (requestMethod request, pathInfo request) of
+      (method, [asset])
+        | method == methodGet
+        , validAssetName asset -> do
+            let path = "web/dist/assets/" <> T.unpack asset
+            exists <- doesFileExist path
+            if exists
+              then sendResponse $
+                responseFile
+                  status200
+                  [ (hContentType, assetContentType asset)
+                  , ("X-Content-Type-Options", "nosniff")
+                  , ("Cache-Control", "public, max-age=31536000, immutable")
+                  ]
+                  path
+                  Nothing
+              else sendResponse (responseLBS status404 [] "")
+      (method, _) | method /= methodGet ->
+        sendResponse (responseLBS status405 [] "")
+      _ ->
+        sendResponse (responseLBS status404 [] "")
+  where
+    validAssetName asset =
+      not (T.null asset)
+        && T.all
+          (\character ->
+            character >= 'a' && character <= 'z'
+              || character >= 'A' && character <= 'Z'
+              || character >= '0' && character <= '9'
+              || character `elem` (".-_" :: String))
+          asset
+    assetContentType asset
+      | ".js" `T.isSuffixOf` asset = "text/javascript; charset=utf-8"
+      | ".css" `T.isSuffixOf` asset = "text/css; charset=utf-8"
+      | otherwise = "application/octet-stream"
 
 authenticationHandler :: Config -> AuthHandler Request SessionContext
 authenticationHandler cfg = mkAuthHandler $ \request -> do
@@ -255,7 +338,7 @@ loginResponse cfg token csrf =
         (expiredCookieValue
           (cfgOidcTransactionCookieName cfg)
           "/oidc/callback") $
-        addHeader "/" NoContent
+        addHeader "/app" NoContent
 
 handleLogoutRequest
   :: Env
@@ -282,38 +365,30 @@ handleBrowseRequest
   -> Maybe SearchQuery
   -> Maybe PaginationToken
   -> Handler BrowseView
-handleBrowseRequest env session selectedRoot selectedPrefix search _continuation = do
+handleBrowseRequest env session selectedRoot selectedPrefix search continuation = do
   let user = sessionUser session
       root = fromMaybe Personal selectedRoot
       prefix = maybe "" browsePrefixText selectedPrefix
   liftIO (ensurePersonalPool (envDb env) (envConfig env) (suUserId user))
   result <- liftIO $ case search of
-    Nothing -> listEntries env user root prefix
+    Nothing -> do
-    Just query -> searchEntries env user root (unSearchQuery query)
+      listed <- listEntries env user root prefix
-  entries <- either
+        (unPaginationToken <$> continuation)
+      pure (fmap (\(entries, next) -> (entries, next, False)) listed)
+    Just query -> do
+      found <- searchEntries env user root (unSearchQuery query)
+      pure (fmap (\(entries, partial) -> (entries, Nothing, partial)) found)
+  (entries, nextContinuation, partial) <- either
     (throwOperationError status502Error . BrowseObjectStoreFailed)
     pure
     result
-  uploadOperation <- liftIO (toText <$> nextRandom)
-  deleteOperations <- liftIO (mapM (\_ -> toText <$> nextRandom) entries)
   let response = BrowseResponse
         { browseEntries = entries
-        , browseContinuation = Nothing
+        , browseContinuation = PaginationToken <$> nextContinuation
-        , browsePartial = False
+        , browsePartial = partial
         }
-      csrf = maybe "" unCsrfToken (sessionCsrf session)
   pure BrowseView
-    { browseViewHtml = HtmlPage
+    { browseViewHtml = HtmlPage (productPage entries)
-        (browsePage
-          user
-          root
-          prefix
-          csrf
-          uploadOperation
-          deleteOperations
-          entries
-          Nothing
-          "")
     , browseViewJson = response
     }
 
@@ -322,8 +397,11 @@ handleDownloadRequest
   -> SessionContext
   -> Root
   -> RelativePath
+  -> Maybe Text
   -> Handler DownloadSuccess
-handleDownloadRequest env session root path = do
+handleDownloadRequest env session root path requestedRange = do
+  when (requestedRange /= Nothing) $
+    throwOperationError err416 DownloadRangeUnsupported
   let user = sessionUser session
       key = buildObjectKey root (suUserId user) path
   metadata <- liftIO (headObject (envS3 env) key)
@@ -339,10 +417,11 @@ handleDownloadRequest env session root path = do
     [ ("root", A.toJSON (rootLabel root))
     , ("bytes", A.toJSON (oiSize info))
     ]
-  let filename = sanitizeFilename (basename path)
+  let filename = basename path
   pure $
-    addHeader ("attachment; filename=\"" <> filename <> "\"") $
+    addHeader (contentDisposition filename) $
       addHeader "nosniff" $
+        addHeader "sandbox" $
           addHeader (oiSize info) body
 
 handleUploadRequest
@@ -457,19 +536,81 @@ handleDeletePrefixRequest
   -> SessionContext
   -> DeletePrefixRequest
   -> Handler DeletePrefixResponse
-handleDeletePrefixRequest env session request = do
+handleDeletePrefixRequest _env session request = do
   requireCsrf DeletePrefixCsrfRejected session (deletePrefixCsrf request)
-  result <- liftIO $
+  throwOperationError err409
-    deletePrefix
+    (DeletePrefixMutationRejected
-      env
+      "use delete-plan and delete-batch with client operation ids")
-      (sessionUser session)
+
-      (deletePrefixRoot request)
+handleDeletePlanRequest
-      (unRelativePath (deletePrefixPath request))
+  :: Env
-  count <- either
+  -> SessionContext
+  -> Root
+  -> RelativePath
+  -> Maybe PaginationToken
+  -> Handler DeletePlanResponse
+handleDeletePlanRequest env session root path continuation = do
+  let user = sessionUser session
+      rootPrefix = case root of
+        Personal -> "users/" <> unUserId (suUserId user) <> "/"
+        Shared   -> "shared/"
+      objectPrefix = rootPrefix <> unRelativePath path <> "/"
+  listed <- liftIO $
+    listObjects
+      (envS3 env)
+      objectPrefix
+      Nothing
+      (unPaginationToken <$> continuation)
+      (cfgDeletePageSize (envConfig env))
+  page <- either
+    (throwOperationError status502Error
+      . DeletePrefixMutationRejected
+      . renderS3Error)
+    pure
+    listed
+  paths <- either
     (throwOperationError err409 . DeletePrefixMutationRejected)
     pure
-    result
+    (traverse
-  pure (DeletePrefixResponse count)
+      (validateRelativePath . T.drop (T.length rootPrefix) . fst)
+      (lpObjects page))
+  pure DeletePlanResponse
+    { deletePlanPaths = paths
+    , deletePlanContinuation = PaginationToken <$> lpContinuationToken page
+    }
+
+handleDeleteBatchRequest
+  :: Env
+  -> SessionContext
+  -> DeleteBatchRequest
+  -> Handler DeleteBatchResponse
+handleDeleteBatchRequest env session request = do
+  requireCsrf DeletePrefixCsrfRejected session (deleteBatchCsrf request)
+  let items = deleteBatchItems request
+  when (null items || length items > cfgDeletePageSize (envConfig env)) $
+    throwOperationError err409
+      (DeletePrefixMutationRejected "delete batch size is invalid")
+  results <- liftIO $ forM items $ \item -> do
+    outcome <- runDelete
+      env
+      (sessionUser session)
+      (deleteBatchRoot request)
+      (deleteBatchPath item)
+      (deleteBatchOperationId item)
+    pure $ case outcome of
+      Left message -> DeleteItemResponse
+        { deleteItemPath = deleteBatchPath item
+        , deleteItemOperationId = deleteBatchOperationId item
+        , deleteItemResult = Nothing
+        , deleteItemError = Just message
+        }
+      Right result -> DeleteItemResponse
+        { deleteItemPath = deleteBatchPath item
+        , deleteItemOperationId = deleteBatchOperationId item
+        , deleteItemResult = Just result
+        , deleteItemError = Nothing
+        }
+  pure (DeleteBatchResponse results)
 
 requireCsrf :: A.ToJSON error => error -> SessionContext -> CsrfToken -> Handler ()
 requireCsrf csrfError session provided =
@@ -530,12 +671,16 @@ mutationAuditResult MutationFailed    = "failed"
 mutationAuditResult MutationRejected  = "rejected"
 mutationAuditResult MutationConflict  = "conflict"
 
-sanitizeFilename :: Text -> Text
+contentDisposition :: Text -> Text
-sanitizeFilename =
+contentDisposition filename =
-  T.map $ \character ->
+  "attachment; filename=\"" <> fallback <> "\"; filename*=UTF-8''" <> encoded
-    if character `elem` ("\"\\\r\n" :: String)
+  where
-      then '_'
+    fallback = T.map safeAscii filename
-      else character
+    encoded = TE.decodeUtf8 (URI.urlEncode True (TE.encodeUtf8 filename))
+    safeAscii character
+      | character >= ' ' && character <= '~'
+          && character `notElem` ("\"\\;" :: String) = character
+      | otherwise = '_'
 
 runPut
   :: Env
@@ -570,7 +715,7 @@ runPut env user root rel op size sha body = do
     Just outcome ->
       case outcome of
         AdmitConflict -> pure (Right MutationConflict)
-        AdmitRejected reason _ -> pure (Left (PutRejected reason))
+        AdmitRejected _ _ -> pure (Right MutationRejected)
         AdmitReplay MutationPending _ -> pure (Right MutationPending)
         AdmitReplay result _ -> pure (Right result)
         AdmitPrepared rec ->
@@ -579,7 +724,6 @@ runPut env user root rel op size sha body = do
             user
             root
             rec
-            PutSettlementFailed
             (PutDispatchFailed (PutObjectStoreError S3TransportError))
             (putObjectStream
               (envS3 env)
@@ -591,17 +735,13 @@ runPut env user root rel op size sha body = do
               body
               >>= pure . either (Left . PutDispatchFailed) Right)
 
-data PutFailure
+newtype PutFailure
-  = PutRejected Text
+  = PutDispatchFailed PutObjectError
-  | PutDispatchFailed PutObjectError
-  | PutSettlementFailed
   deriving stock (Eq, Show)
 
 throwPutFailure :: PutFailure -> Handler a
 throwPutFailure failure =
   case failure of
-    PutRejected reason ->
-      throwOperationError err409 (UploadMutationRejected reason)
     PutDispatchFailed (PutObjectStreamError streamError) ->
       case streamError of
         UploadStreamInvalid message ->
@@ -619,9 +759,6 @@ throwPutFailure failure =
     PutDispatchFailed (PutObjectStoreError err) ->
       throwOperationError err409
         (UploadMutationRejected (renderS3Error err))
-    PutSettlementFailed ->
-      throwOperationError err409
-        (UploadMutationRejected "mutation failed after store settlement")
 
 runDelete
   :: Env
@@ -652,7 +789,7 @@ runDelete env user root rel op = do
     Just outcome ->
       case outcome of
         AdmitConflict -> pure (Right MutationConflict)
-        AdmitRejected reason _ -> pure (Left reason)
+        AdmitRejected _ _ -> pure (Right MutationRejected)
         AdmitReplay MutationPending _ -> pure (Right MutationPending)
         AdmitReplay result _ -> pure (Right result)
         AdmitPrepared rec ->
@@ -661,70 +798,19 @@ runDelete env user root rel op = do
             user
             root
             rec
-            "mutation failed after store settlement"
             "object request timed out"
             (deleteObject (envS3 env) key
               >>= pure . either (Left . renderS3Error) Right)
 
-deletePrefix :: Env -> SessionUser -> Root -> Text -> IO (Either Text Int)
-deletePrefix env user root prefix = do
-  let listPrefix =
-        case root of
-          Personal ->
-            "users/" <> unUserId (suUserId user) <> "/" <> withSlash prefix
-          Shared ->
-            "shared/" <> withSlash prefix
-  keysResult <- collectKeys (envS3 env) listPrefix
-  case keysResult of
-    Left message -> pure (Left message)
-    Right keys -> do
-      let rootPrefix =
-            case root of
-              Personal -> "users/" <> unUserId (suUserId user) <> "/"
-              Shared   -> "shared/"
-          relativePaths =
-            [ RelativePath relative
-            | key <- keys
-            , T.isPrefixOf rootPrefix key
-            , let relative = T.drop (T.length rootPrefix) key
-            , not (T.null relative)
-            ]
-      results <- mapM
-        (\relativePath -> do
-            operation <- OperationId . toText <$> nextRandom
-            runDelete env user root relativePath operation)
-        relativePaths
-      let deleted = length [() | Right MutationSucceeded <- results]
-          failure = listToMaybe [message | Left message <- results]
-      pure (maybe (Right deleted) Left failure)
-  where
-    withSlash path
-      | T.isSuffixOf "/" path = path
-      | otherwise = path <> "/"
-
-collectKeys :: S3 -> Text -> IO (Either Text [Text])
-collectKeys s3 prefix = go Nothing []
-  where
-    go continuation accumulated = do
-      page <- listObjects s3 prefix Nothing continuation 1000
-      case page of
-        Left message -> pure (Left (renderS3Error message))
-        Right result -> do
-          let accumulated' = accumulated <> map fst (lpObjects result)
-          if lpIsTruncated result
-            then go (lpContinuationToken result) accumulated'
-            else pure (Right accumulated')
-
 dispatchAndFinalize
   :: Env
   -> SessionUser
   -> Root
   -> MutationRecord
   -> failure
-  -> failure
   -> IO (Either failure ())
   -> IO (Either failure MutationResult)
-dispatchAndFinalize env user root rec settlementFailure timeoutFailure dispatch = do
+dispatchAndFinalize env user root rec timeoutFailure dispatch = do
   let cfg = envConfig env
       requestTimeoutSec = cfgObjectRequestTimeoutSec cfg
   prepared <- withTransaction (envDb env) $ \conn -> do
@@ -759,8 +845,7 @@ dispatchAndFinalize env user root rec settlementFailure timeoutFailure dispatch
                   cacheInvalidatePrefixes (envRedis env) (suUserId user) root
                     (listCacheAncestorPrefixes (mrRelativePath rec))
                   pure (Right MutationSucceeded)
-                Just MutationFailed ->
+                Just MutationFailed -> pure (Right MutationFailed)
-                  pure (Left settlementFailure)
                 Just other -> pure (Right other)
                 Nothing -> pure (Right MutationPending)
 
@@ -773,8 +858,14 @@ observeObject s3 key = do
     Left S3NotFound -> pure ObjectAbsent
     Left err -> pure (ObjectUnavailable (renderS3Error err))
 
-listEntries :: Env -> SessionUser -> Root -> Text -> IO (Either Text [ListEntry])
+listEntries
-listEntries env user root prefix = do
+  :: Env
+  -> SessionUser
+  -> Root
+  -> Text
+  -> Maybe Text
+  -> IO (Either Text ([ListEntry], Maybe Text))
+listEntries env user root prefix continuation = do
   let cacheKey =
         "nuthatch:list:"
           <> unUserId (suUserId user)
@@ -783,6 +874,8 @@ listEntries env user root prefix = do
           <> ":"
           <> prefix
           <> ":"
+          <> T.pack (show (cfgBrowsePageSize (envConfig env)))
+          <> ":"
       s3Prefix =
         case root of
           Personal -> "users/" <> unUserId (suUserId user) <> "/" <> prefixSlash
@@ -791,11 +884,18 @@ listEntries env user root prefix = do
         | T.null prefix = ""
         | T.isSuffixOf "/" prefix = prefix
         | otherwise = prefix <> "/"
-  cached <- cacheGet (envRedis env) cacheKey
+  cached <- case continuation of
+    Nothing -> cacheGet (envRedis env) cacheKey
+    Just _ -> pure Nothing
   case cached >>= A.decodeStrict of
-    Just entries -> pure (Right entries)
+    Just result -> pure (Right result)
     Nothing -> do
-      page <- listObjects (envS3 env) s3Prefix (Just "/") Nothing 1000
+      page <- listObjects
+        (envS3 env)
+        s3Prefix
+        (Just "/")
+        continuation
+        (cfgBrowsePageSize (envConfig env))
       case page of
         Left err -> pure (Left (renderS3Error err))
         Right lp -> do
@@ -827,23 +927,37 @@ listEntries env user root prefix = do
                 , not (T.isSuffixOf "/" rel)
                 ]
               entries = folders <> files
+              result = (entries, lpContinuationToken lp)
+          when (continuation == Nothing) $
             cacheSet (envRedis env) cacheKey (cfgListCacheTtlSec (envConfig env))
-            (BL.toStrict (A.encode entries))
+              (BL.toStrict (A.encode result))
-          pure (Right entries)
+          pure (Right result)
 
-searchEntries :: Env -> SessionUser -> Root -> Text -> IO (Either Text [ListEntry])
+searchEntries
+  :: Env
+  -> SessionUser
+  -> Root
+  -> Text
+  -> IO (Either Text ([ListEntry], Bool))
 searchEntries env user root q = do
   let s3Prefix =
         case root of
           Personal -> "users/" <> unUserId (suUserId user) <> "/"
           Shared   -> "shared/"
-      needle = T.toLower q
+      needle = T.toCaseFold q
-  keysResult <- collectKeysBounded (envS3 env) s3Prefix (cfgSearchMaxKeys (envConfig env))
+  started <- getMonotonicTimeNSec
+  let deadline =
+        started + fromInteger (cfgSearchTimeoutMs (envConfig env) * 1000000)
+  keysResult <- collectKeysBounded
+    (envS3 env)
+    s3Prefix
+    (cfgSearchMaxKeys (envConfig env))
+    deadline
   pure $ case keysResult of
     Left err -> Left err
-    Right keys ->
+    Right (keys, partial) ->
       Right
-        [ ListEntry
+        ( [ ListEntry
             { leName = lastSeg rel
             , leIsPrefix = False
             , leSize = Just sz
@@ -853,24 +967,54 @@ searchEntries env user root q = do
         , T.isPrefixOf s3Prefix k
         , let rel = T.drop (T.length s3Prefix) k
         , not (T.null rel)
-        , needle `T.isInfixOf` T.toLower rel
+        , needle `T.isInfixOf` T.toCaseFold rel
         ]
+        , partial
+        )
 
-collectKeysBounded :: S3 -> Text -> Int -> IO (Either Text [(Text, Integer)])
+collectKeysBounded
-collectKeysBounded s3 prefix maxKeys = go Nothing [] 0
+  :: S3
+  -> Text
+  -> Int
+  -> Word64
+  -> IO (Either Text ([(Text, Integer)], Bool))
+collectKeysBounded s3 prefix =
+  collectKeysBoundedWith
+    getMonotonicTimeNSec
+    (\continuation limit ->
+      first renderS3Error
+        <$> listObjects s3 prefix Nothing continuation limit)
+
+collectKeysBoundedWith
+  :: IO Word64
+  -> (Maybe Text -> Int -> IO (Either Text ListPage))
+  -> Int
+  -> Word64
+  -> IO (Either Text ([(Text, Integer)], Bool))
+collectKeysBoundedWith currentTime listPage maxKeys deadline =
+  go Nothing [] 0
   where
     go mTok acc n
-      | n >= maxKeys = pure (Right (take maxKeys acc))
+      | n >= maxKeys = pure (Right (take maxKeys acc, True))
       | otherwise = do
-          page <- listObjects s3 prefix Nothing mTok (min 1000 (maxKeys - n))
+          now <- currentTime
-          case page of
+          if now >= deadline
-            Left err -> pure (Left (renderS3Error err))
+            then pure (Right (take maxKeys acc, True))
-            Right lp -> do
+            else do
+              let remainingMicros =
+                    fromIntegral ((deadline - now + 999) `div` 1000)
+              timedPage <- timeout remainingMicros $
+                listPage mTok (min 1000 (maxKeys - n))
+              case timedPage of
+                Nothing -> pure (Right (take maxKeys acc, True))
+                Just (Left err) -> pure (Left err)
+                Just (Right lp) -> do
                   let acc' = acc <> lpObjects lp
                       n' = length acc'
                   if lpIsTruncated lp && n' < maxKeys
                     then go (lpContinuationToken lp) acc' n'
-                else pure (Right (take maxKeys acc'))
+                    else pure
+                      (Right (take maxKeys acc', lpIsTruncated lp))
 
 runRecovery :: Env -> IO ()
 runRecovery env = forever $ do

src/Nuthatch/Config.hs

@@ -48,7 +48,10 @@ data Config = Config
   , cfgThrottleBytesPerSec :: Integer
   , cfgThrottleBurstBytes  :: Integer
   , cfgListCacheTtlSec     :: Integer
+  , cfgBrowsePageSize      :: Int
   , cfgSearchMaxKeys       :: Int
+  , cfgSearchTimeoutMs     :: Integer
+  , cfgDeletePageSize      :: Int
   , cfgRecoveryGraceSec    :: Integer
   , cfgIdempotencyWindowSec :: Integer
   , cfgObjectRequestTimeoutSec :: Integer
@@ -112,7 +115,10 @@ loadConfig = do
   when (throttleBurst <= 0 || throttleBurst > luaExactIntegerMax) $
     fail "NUTHATCH_THROTTLE_BURST_BYTES exceeds the exact throttle range"
   listTtl <- envInteger "NUTHATCH_LIST_CACHE_TTL_SEC" 30
+  browsePageSize <- fromInteger <$> envInteger "NUTHATCH_BROWSE_PAGE_SIZE" 200
   searchMax <- fromInteger <$> envInteger "NUTHATCH_SEARCH_MAX_KEYS" 500
+  searchTimeoutMs <- envInteger "NUTHATCH_SEARCH_TIMEOUT_MS" 2000
+  deletePageSize <- fromInteger <$> envInteger "NUTHATCH_DELETE_PAGE_SIZE" 100
   recoveryGrace <- envInteger "NUTHATCH_RECOVERY_GRACE_SEC" 90
   idempotencyWindow <- envInteger "NUTHATCH_IDEMPOTENCY_WINDOW_SEC" 86400
   objectRequestTimeout <- envInteger "NUTHATCH_OBJECT_REQUEST_TIMEOUT_SEC" 300
@@ -122,6 +128,14 @@ loadConfig = do
     fail "NUTHATCH_IDEMPOTENCY_WINDOW_SEC must be positive"
   when (objectRequestTimeout <= 0) $
     fail "NUTHATCH_OBJECT_REQUEST_TIMEOUT_SEC must be positive"
+  when (browsePageSize <= 0 || browsePageSize > 1000) $
+    fail "NUTHATCH_BROWSE_PAGE_SIZE must be between 1 and 1000"
+  when (searchMax <= 0 || searchMax > 100000) $
+    fail "NUTHATCH_SEARCH_MAX_KEYS must be between 1 and 100000"
+  when (searchTimeoutMs <= 0 || searchTimeoutMs > 60000) $
+    fail "NUTHATCH_SEARCH_TIMEOUT_MS must be between 1 and 60000"
+  when (deletePageSize <= 0 || deletePageSize > 1000) $
+    fail "NUTHATCH_DELETE_PAGE_SIZE must be between 1 and 1000"
   pure Config
     { cfgListenHost = host
     , cfgListenPort = port
@@ -156,7 +170,10 @@ loadConfig = do
     , cfgThrottleBytesPerSec = throttleRate
     , cfgThrottleBurstBytes = throttleBurst
     , cfgListCacheTtlSec = listTtl
+    , cfgBrowsePageSize = browsePageSize
     , cfgSearchMaxKeys = searchMax
+    , cfgSearchTimeoutMs = searchTimeoutMs
+    , cfgDeletePageSize = deletePageSize
     , cfgRecoveryGraceSec = recoveryGrace
     , cfgIdempotencyWindowSec = idempotencyWindow
     , cfgObjectRequestTimeoutSec = objectRequestTimeout

src/Nuthatch/Ui.hs

@@ -1,6 +1,6 @@
 module Nuthatch.Ui
   ( browserScript
-  , browsePage
+  , productPage
   , htmlResponse
   , escapeHtml
   ) where
@@ -29,194 +29,27 @@ escapeHtml =
     '\'' -> "'"
     c    -> T.singleton c
 
-browsePage
+productPage :: [ListEntry] -> Text
-  :: SessionUser
+productPage entries =
-  -> Root
-  -> Text
-  -> Text
-  -> Text
-  -> [Text]
-  -> [ListEntry]
-  -> Maybe Text
-  -> Text
-  -> Text
-browsePage user root prefix csrf uploadOp deleteOps entries mError notice =
-  page "Nuthatch" $ T.unlines $
-    [ "<header>"
-    , "  <h1>Nuthatch</h1>"
-    , "  <div class=\"meta\">"
-    , "    Signed in as <strong>"
-        <> escapeHtml (maybe (unUserId (suUserId user)) id (suDisplay user))
-        <> "</strong>"
-    , "    · <form class=\"inline\" data-nuthatch=\"logout\">"
-    , "      <input type=\"hidden\" name=\"csrf\" value=\"" <> escapeHtml csrf <> "\">"
-    , "      <button type=\"submit\">Log out</button>"
-    , "    </form>"
-    , "  </div>"
-    , "</header>"
-    , if T.null notice then "" else "<p class=\"ok\">" <> escapeHtml notice <> "</p>"
-    , maybe "" (\e -> "<p class=\"err\">" <> escapeHtml e <> "</p>") mError
-    , "<nav class=\"roots\">"
-    , rootLink Personal root prefix
-    , rootLink Shared root prefix
-    , "</nav>"
-    , "<p class=\"path\">/" <> escapeHtml (rootLabel root)
-        <> if T.null prefix then "" else "/" <> escapeHtml prefix
-        <> "</p>"
-    , breadcrumbs root prefix
-    , "<section>"
-    , "  <h2>Upload</h2>"
-    , "  <form method=\"post\" action=\"/upload\" enctype=\"multipart/form-data\" data-nuthatch=\"upload\">"
-    , "    <input type=\"hidden\" name=\"csrf\" value=\"" <> escapeHtml csrf <> "\">"
-    , "    <input type=\"hidden\" name=\"operation_id\" value=\"" <> escapeHtml uploadOp <> "\">"
-    , "    <input type=\"hidden\" name=\"root\" value=\"" <> escapeHtml (rootLabel root) <> "\">"
-    , "    <input type=\"hidden\" name=\"prefix\" value=\"" <> escapeHtml prefix <> "\">"
-    , "    <input type=\"file\" name=\"file\" required>"
-    , "    <button type=\"submit\">Upload</button>"
-    , "  </form>"
-    , "</section>"
-    , "<section>"
-    , "  <h2>Search</h2>"
-    , "  <form method=\"get\" action=\"/\">"
-    , "    <input type=\"hidden\" name=\"root\" value=\"" <> escapeHtml (rootLabel root) <> "\">"
-    , "    <input type=\"hidden\" name=\"prefix\" value=\"" <> escapeHtml prefix <> "\">"
-    , "    <input name=\"q\" placeholder=\"substring in key\">"
-    , "    <button type=\"submit\">Search</button>"
-    , "  </form>"
-    , "</section>"
-    , "<section>"
-    , "  <h2>Contents</h2>"
-    , "  <table><thead><tr><th>Name</th><th>Size</th><th></th></tr></thead><tbody>"
-    ]
-    <> zipWith (renderEntry root csrf) deleteOps entries
-    <>
-    [ "  </tbody></table>"
-    , if null entries then "<p><em>Empty</em></p>" else ""
-    , "</section>"
-    ]
-
-rootLink :: Root -> Root -> Text -> Text
-rootLink target current prefix =
-  let label = if target == Shared then "Shared" else "Personal"
-      cls = if target == current then "active" else ""
-  in "<a class=\"" <> cls <> "\" href=\"/?root=" <> rootLabel target
-       <> if target == current && not (T.null prefix)
-            then "&prefix=" <> prefix
-            else ""
-       <> "\">" <> label <> "</a>"
-
-breadcrumbs :: Root -> Text -> Text
-breadcrumbs root prefix
-  | T.null prefix = ""
-  | otherwise =
-      let segs = T.splitOn "/" prefix
-          steps = zip segs (scanl1 (\a b -> a <> "/" <> b) segs)
-          links =
-            ("<a href=\"/?root=" <> rootLabel root <> "\">root</a>")
-              : [ "<a href=\"/?root=" <> rootLabel root <> "&prefix=" <> path <> "\">"
-                    <> escapeHtml name <> "</a>"
-                | (name, path) <- steps
-                ]
-      in "<p class=\"crumbs\">" <> T.intercalate " / " links <> "</p>"
-
-renderEntry :: Root -> Text -> Text -> ListEntry -> Text
-renderEntry root csrf opId entry =
-  if leIsPrefix entry
-    then
-      let next = leRelativePath entry
-      in "<tr><td colspan=\"2\"><a href=\"/?root=" <> rootLabel root
-           <> "&prefix=" <> next <> "\">" <> escapeHtml (leName entry) <> "/</a></td>"
-           <> "<td>"
-           <> deleteForm root next csrf opId True
-           <> "</td></tr>"
-    else
-      "<tr><td><a href=\"/download?root=" <> rootLabel root
-        <> "&path=" <> leRelativePath entry <> "\">"
-        <> escapeHtml (leName entry) <> "</a></td><td>"
-        <> maybe "-" (T.pack . show) (leSize entry)
-        <> "</td><td>"
-        <> deleteForm root (leRelativePath entry) csrf opId False
-        <> "</td></tr>"
-
-deleteForm :: Root -> Text -> Text -> Text -> Bool -> Text
-deleteForm root path csrf opId isPrefix =
-  "<form class=\"inline\" method=\"post\" action=\"/delete\" data-nuthatch=\"delete\" onsubmit=\"return confirm('Delete "
-    <> escapeHtml path <> "?');\">"
-    <> "<input type=\"hidden\" name=\"csrf\" value=\"" <> escapeHtml csrf <> "\">"
-    <> "<input type=\"hidden\" name=\"operation_id\" value=\"" <> escapeHtml opId <> "\">"
-    <> "<input type=\"hidden\" name=\"root\" value=\"" <> escapeHtml (rootLabel root) <> "\">"
-    <> "<input type=\"hidden\" name=\"path\" value=\"" <> escapeHtml path <> "\">"
-    <> "<input type=\"hidden\" name=\"prefix_delete\" value=\""
-    <> (if isPrefix then "1" else "0") <> "\">"
-    <> "<button type=\"submit\">Delete</button></form>"
-
-page :: Text -> Text -> Text
-page title body =
   T.unlines
-    [ "<!DOCTYPE html>"
+    [ "<!doctype html>"
     , "<html lang=\"en\"><head>"
     , "<meta charset=\"utf-8\">"
-    , "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">"
+    , "<meta name=\"viewport\" content=\"width=device-width,initial-scale=1\">"
-    , "<title>" <> escapeHtml title <> "</title>"
+    , "<meta http-equiv=\"Content-Security-Policy\" content=\"default-src 'self'; object-src 'none'; base-uri 'none'\">"
-    , "<style>"
+    , "<title>Nuthatch</title>"
-    , "body{font-family:system-ui,sans-serif;margin:2rem auto;max-width:900px;line-height:1.4;color:#122}"
+    , "</head><body><main>"
-    , "header{display:flex;justify-content:space-between;align-items:baseline;gap:1rem}"
+    , "<h1>Nuthatch</h1>"
-    , "a{color:#0b57d0;text-decoration:none}a:hover{text-decoration:underline}"
+    , "<p>The browser application has moved to <a href=\"/app\">/app</a>.</p>"
-    , "nav.roots a{margin-right:1rem;padding:.2rem .5rem;border-radius:4px}"
+    , "<ul>"
-    , "nav.roots a.active{background:#e8eefc;font-weight:600}"
+    , T.concat
-    , "table{width:100%;border-collapse:collapse;margin-top:.5rem}"
+        [ "<li>" <> escapeHtml (leRelativePath entry) <> "</li>"
-    , "th,td{text-align:left;padding:.4rem .3rem;border-bottom:1px solid #ddd}"
+        | entry <- entries
-    , "form.inline{display:inline}"
+        ]
-    , ".err{color:#a40000;background:#fde8e8;padding:.5rem .75rem;border-radius:4px}"
+    , "</ul>"
-    , ".ok{color:#0d5a0d;background:#e7f6e7;padding:.5rem .75rem;border-radius:4px}"
+    , "</main></body></html>"
-    , "section{margin:1.5rem 0}"
-    , "input,button{font:inherit;margin:.25rem .25rem .25rem 0}"
-    , "button{cursor:pointer}"
-    , "</style>"
-    , "<meta http-equiv=\"Content-Security-Policy\" content=\"default-src 'self'; style-src 'unsafe-inline'; img-src 'none'; object-src 'none'\">"
-    , "<script src=\"/nuthatch.js\" defer></script>"
-    , "</head><body>"
-    , body
-    , "</body></html>"
     ]
 
 browserScript :: Text
-browserScript = T.unlines
+browserScript =
-  [ "const hex = bytes => Array.from(new Uint8Array(bytes), byte => byte.toString(16).padStart(2, '0')).join('');"
+  "const nuthatchApp = '/app'; if (window.location.pathname === '/') window.location.assign(nuthatchApp);"
-  , "const fail = async response => { if (!response.ok) throw new Error((await response.json()).message || response.statusText); };"
-  , "document.addEventListener('submit', async event => {"
-  , "  const form = event.target.closest('form[data-nuthatch]');"
-  , "  if (!form) return;"
-  , "  event.preventDefault();"
-  , "  const fields = new FormData(form);"
-  , "  try {"
-  , "    if (form.dataset.nuthatch === 'logout') {"
-  , "      const response = await fetch('/logout', { method: 'POST', headers: { 'X-CSRF-Token': fields.get('csrf') } });"
-  , "      await fail(response);"
-  , "      location.assign('/login');"
-  , "      return;"
-  , "    }"
-  , "    if (form.dataset.nuthatch === 'upload') {"
-  , "      const file = fields.get('file');"
-  , "      const prefix = fields.get('prefix');"
-  , "      const path = prefix ? `${prefix}/${file.name}` : file.name;"
-  , "      const digest = hex(await crypto.subtle.digest('SHA-256', await file.arrayBuffer()));"
-  , "      const query = new URLSearchParams({ root: fields.get('root'), path, operation_id: fields.get('operation_id') });"
-  , "      const response = await fetch(`/upload?${query}`, { method: 'POST', headers: { 'Content-Type': 'application/octet-stream', 'X-Declared-Size': String(file.size), 'X-Content-SHA256': digest, 'X-CSRF-Token': fields.get('csrf') }, body: file });"
-  , "      await fail(response);"
-  , "      location.reload();"
-  , "      return;"
-  , "    }"
-  , "    const prefixDelete = fields.get('prefix_delete') === '1';"
-  , "    const endpoint = prefixDelete ? '/delete-prefix' : '/delete';"
-  , "    const request = prefixDelete"
-  , "      ? { root: fields.get('root'), path: fields.get('path'), csrf: fields.get('csrf') }"
-  , "      : { root: fields.get('root'), path: fields.get('path'), operation_id: fields.get('operation_id'), csrf: fields.get('csrf') };"
-  , "    const response = await fetch(endpoint, { method: 'POST', headers: { 'Content-Type': 'application/json' }, body: JSON.stringify(request) });"
-  , "    await fail(response);"
-  , "    location.reload();"
-  , "  } catch (error) {"
-  , "    alert(error.message);"
-  , "  }"
-  , "});"
-  ]

test/RecoveryPhase.hs

@@ -53,7 +53,6 @@ runPhase cfg database redis store phase =
         recoverySession
         Shared
         rec
-        "settlement failed"
         "request timed out"
         (putObjectStream
           store

test/Spec.hs

@@ -49,6 +49,7 @@ import           Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import           Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime)
+import           GHC.Clock (getMonotonicTimeNSec)
 import           Hedgehog
   ( Gen
   , Property
@@ -69,7 +70,7 @@ import           Network.HTTP.Types
   , status404
   , status405
   )
-import           Network.Wai (Request (..))
+import           Network.Wai (Request (..), responseLBS)
 import           Network.Wai.Test
   ( SRequest (..)
   , SResponse (..)
@@ -81,6 +82,7 @@ import           Network.Wai.Test
 import           Nuthatch.Api
 import           Nuthatch.App
   ( authenticationHandler
+  , collectKeysBoundedWith
   , loginResponse
   , utf8Boundary
   )
@@ -111,6 +113,7 @@ import           Nuthatch.Recovery
   , trySynchronous
   , withLinkedWorker
   )
+import           Nuthatch.S3 (ListPage (..))
 import           Nuthatch.Types
 import           Nuthatch.Session (mintSession)
 import           Nuthatch.Streaming
@@ -119,7 +122,7 @@ import           Nuthatch.Streaming
   , maximumMultipartBytes
   , multipartPartBytes
   )
-import           Nuthatch.Ui (browsePage, browserScript)
+import           Nuthatch.Ui (browserScript, productPage)
 import           Servant
 import           Servant.Server.Experimental.Auth (AuthHandler, mkAuthHandler)
 import           Servant.Types.SourceT
@@ -143,10 +146,28 @@ tests = testGroup "nuthatch-unit"
   , protocolTests
   , recoveryTests
   , streamingTests
+  , productBehaviorTests
   , oidcTests
   , apiTests
   ]
 
+productBehaviorTests :: TestTree
+productBehaviorTests = testGroup "product behavior"
+  [ testCase "search deadline cancels an in-flight listing" $ do
+      started <- getMonotonicTimeNSec
+      result <- collectKeysBoundedWith
+        getMonotonicTimeNSec
+        (\_ _ -> do
+          threadDelay 100000
+          pure (Right (ListPage [] [] Nothing False)))
+        100
+        (started + 5000000)
+      finished <- getMonotonicTimeNSec
+      result @?= Right ([], True)
+      assertBool "listing returns inside the configured deadline margin"
+        (finished - started < 50000000)
+  ]
+
 streamingTests :: TestTree
 streamingTests = testGroup "streaming"
   [ testCase "upload bodies are inspected and emitted in bounded parts" $ do
@@ -537,7 +558,7 @@ apiTests = testGroup "typed HTTP boundary"
         ("prefix_mutation_rejected" `BS.isInfixOf` BL.toStrict prefixError)
   , testCase "production authentication validates cookies and callback emits secure cookies"
       testAuthenticationBoundary
-  , testCase "retained browser forms are wired to the typed API bridge"
+  , testCase "legacy browser entry directs safely to the static application"
       testBrowserBridge
   , testCase "links derive from the type-level API" $
       show (linkURI (safeLink api (Proxy :: Proxy HealthEndpoint)))
@@ -730,6 +751,9 @@ typedTestServer calls =
        counted (HealthResponse True)
   :<|> counted (ReadyResponse True)
   :<|> counted (BrowserScript "script")
+  :<|> (\_ -> counted (addHeader "default-src 'none'" (HtmlPage "app")))
+  :<|> (\_ -> Tagged $ \_ sendResponse ->
+        sendResponse (responseLBS status404 [] ""))
   :<|> counted
         (addHeader "transaction=cookie"
           (addHeader "https://issuer.example/authorize" NoContent))
@@ -737,7 +761,7 @@ typedTestServer calls =
         (addHeader "session=cookie"
           (addHeader "csrf=cookie"
             (addHeader "transaction=expired"
-              (addHeader "/" NoContent)))))
+              (addHeader "/app" NoContent)))))
   :<|> (\_ _ -> counted
         (addHeader "session=expired"
           (addHeader "csrf=expired"
@@ -750,9 +774,10 @@ typedTestServer calls =
             , browseContinuation = Nothing
             , browsePartial = False
             }))
-  :<|> (\_ _ _ -> counted
+  :<|> (\_ _ _ _ -> counted
         (addHeader "attachment; filename=\"file.txt\""
-          (addHeader "nosniff" (addHeader 4 (source ["body"])))))
+          (addHeader "nosniff"
+            (addHeader "sandbox" (addHeader 4 (source ["body"]))))))
   :<|> (\_ _ _ operation _ _ _ _ -> counted UploadResponse
         { uploadResponseOperationId = operation
         , uploadResponseResult = MutationSucceeded
@@ -764,9 +789,47 @@ typedTestServer calls =
         , deleteResponseIdempotencyWindowSeconds = 3600
         })
   :<|> (\_ _ -> counted (DeletePrefixResponse 1))
+  :<|>
+    (    (\session -> counted SessionResponse
+            { sessionResponseUserId = suUserId (sessionUser session)
+            , sessionResponseDisplay = Nothing
+            , sessionResponseCsrf =
+                CsrfToken "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+            })
+    :<|> (\_ _ _ _ _ -> counted emptyBrowse)
+    :<|> (\_ _ _ _ -> counted downloadResponse)
+    :<|> (\_ _ _ operation _ _ _ _ -> counted UploadResponse
+          { uploadResponseOperationId = operation
+          , uploadResponseResult = MutationSucceeded
+          , uploadResponseIdempotencyWindowSeconds = 3600
+          })
+    :<|> (\_ request -> counted DeleteResponse
+          { deleteResponseOperationId = deleteOperationId request
+          , deleteResponseResult = MutationSucceeded
+          , deleteResponseIdempotencyWindowSeconds = 3600
+          })
+    :<|> (\_ _ _ _ -> counted DeletePlanResponse
+          { deletePlanPaths = []
+          , deletePlanContinuation = Nothing
+          })
+    :<|> (\_ _ -> counted (DeleteBatchResponse []))
+    )
   where
     counted :: a -> Handler a
     counted value = liftIO (modifyIORef' calls (+ 1)) >> pure value
+    emptyBrowse =
+      BrowseView
+        (HtmlPage "browse")
+        BrowseResponse
+          { browseEntries = []
+          , browseContinuation = Nothing
+          , browsePartial = False
+          }
+    downloadResponse =
+      addHeader "attachment; filename=\"file.txt\"" $
+        addHeader "nosniff" $
+          addHeader "sandbox" $
+            addHeader 4 (source ["body"])
 
 testAuthenticationBoundary :: IO ()
 testAuthenticationBoundary = do
@@ -780,6 +843,7 @@ testAuthenticationBoundary = do
         | (name, value) <- responseHeaders
         , name == "Set-Cookie"
         ]
+  lookup "Location" responseHeaders @?= Just "/app"
   length cookieHeaders @?= 3
   assertBool "login sets the session cookie"
     (any ("nuthatch_session=" `BS.isPrefixOf`) cookieHeaders)
@@ -847,43 +911,18 @@ testAuthenticationBoundary = do
 
 testBrowserBridge :: IO ()
 testBrowserBridge = do
-  let csrf = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+  let entry = ListEntry
-      user = SessionUser
-        { suIssuer = "issuer"
-        , suSubject = "subject"
-        , suUserId = UserId "user"
-        , suDisplay = Just "User"
-        }
-      entry = ListEntry
         { leName = "folder"
         , leIsPrefix = True
         , leSize = Nothing
-        , leRelativePath = "folder"
+        , leRelativePath = "folder<script>"
         }
-      browse = browsePage
+      browse = productPage [entry]
-        user
+  assertBool "legacy page directs browsers to the static application"
-        Personal
+    ("/app" `T.isInfixOf` browse && "/app" `T.isInfixOf` browserScript)
-        ""
+  assertBool "legacy page escapes object paths"
-        csrf
+    ("folder&lt;script&gt;" `T.isInfixOf` browse
-        "upload-1"
+      && not ("folder<script>" `T.isInfixOf` browse))
-        ["delete-1"]
-        [entry]
-        Nothing
-        ""
-  mapM_
-    (\marker -> assertBool ("browse page includes " <> T.unpack marker)
-      (marker `T.isInfixOf` browse))
-    [ "data-nuthatch=\"upload\""
-    , "data-nuthatch=\"delete\""
-    , "data-nuthatch=\"logout\""
-    ]
-  mapM_
-    (\endpoint -> assertBool ("bridge calls " <> T.unpack endpoint)
-      (endpoint `T.isInfixOf` browserScript))
-    [ "/upload"
-    , "/delete-prefix"
-    , "/logout"
-    ]
 
 productionAuthTestApplication :: Config -> IORef Int -> Application
 productionAuthTestApplication cfg calls =
@@ -928,7 +967,10 @@ testConfig = Config
   , cfgThrottleBytesPerSec = 1024
   , cfgThrottleBurstBytes = 1024
   , cfgListCacheTtlSec = 30
+  , cfgBrowsePageSize = 100
   , cfgSearchMaxKeys = 100
+  , cfgSearchTimeoutMs = 1000
+  , cfgDeletePageSize = 100
   , cfgRecoveryGraceSec = 30
   , cfgIdempotencyWindowSec = 3600
   , cfgObjectRequestTimeoutSec = 300

tests/kind/wp05-job.yaml.in

@@ -233,7 +233,7 @@ spec:
                   sed -n '1,8p' "/tmp/callback-$suffix.body" >&2
                   exit 1
                 fi
-                test "$(header_value "/tmp/callback-$suffix.headers" Location)" = "/"
+                test "$(header_value "/tmp/callback-$suffix.headers" Location)" = "/app"
                 printf 'Application callback accepted %s\n' "$suffix" >&2
                 sed -n \
                   's/^\([Ss]et-[Cc]ookie: [^=]*\)=.*/\1=<redacted>/p' \
@@ -362,6 +362,306 @@ spec:
                 exit 1
               fi
 
+              if [ "${NUTHATCH_PRODUCT_MODE:-}" = timeout ]; then
+                curl --insecure --fail --silent --show-error \
+                  --get \
+                  --cookie "$cookies" \
+                  --data-urlencode root=personal \
+                  --data-urlencode q=timeout-probe \
+                  "$base/api/browse" >/tmp/product-timeout.json
+                grep -F '"partial":true' /tmp/product-timeout.json
+                printf 'Timed search bound probe passed\n'
+                exit 0
+              fi
+
+              if [ "${NUTHATCH_PRODUCT_MODE:-}" = verify ]; then
+                product_upload() {
+                  product_path="$1"
+                  product_operation="$2"
+                  product_body="$3"
+                  printf '%s' "$product_body" >/tmp/product-body
+                  product_size="$(wc -c </tmp/product-body | tr -d ' ')"
+                  product_digest="$(
+                    sha256sum /tmp/product-body | cut -d' ' -f1
+                  )"
+                  curl --insecure --fail --silent --show-error \
+                    --cookie "$cookies" \
+                    --header 'Content-Type: application/octet-stream' \
+                    --header "X-Declared-Size: $product_size" \
+                    --header "X-Content-SHA256: $product_digest" \
+                    --header "X-CSRF-Token: $csrf" \
+                    --data-binary @/tmp/product-body \
+                    "$base/api/upload?root=personal&path=$product_path&operation_id=$product_operation"
+                }
+
+                curl --insecure --fail --silent --show-error \
+                  --cookie "$cookies" \
+                  "$base/api/session" >/tmp/product-session.json
+                grep -F '"user_id":' /tmp/product-session.json
+                grep -F "\"csrf\":\"$csrf\"" /tmp/product-session.json
+                curl --insecure --fail --silent --show-error \
+                  --cookie "$cookies" \
+                  --dump-header /tmp/product-app.headers \
+                  "$base/app" >/tmp/product-app.html
+                grep -i '^content-security-policy:' /tmp/product-app.headers |
+                  grep -F "default-src 'none'" |
+                  grep -F "script-src 'self'" |
+                  grep -F "frame-ancestors 'none'" >/dev/null
+                asset="$(
+                  sed -n 's#.*src="/assets/\([^"]*\.js\)".*#\1#p' \
+                    /tmp/product-app.html
+                )"
+                test -n "$asset"
+                curl --insecure --fail --silent --show-error \
+                  --cookie "$cookies" \
+                  --dump-header /tmp/product-asset.headers \
+                  "$base/assets/$asset" >/tmp/product-asset.js
+                grep -i '^content-type:.*javascript' \
+                  /tmp/product-asset.headers >/dev/null
+                grep -i '^x-content-type-options: *nosniff' \
+                  /tmp/product-asset.headers >/dev/null
+                for marker in \
+                  'Drop a file here' \
+                  'Shared root' \
+                  'Retry same upload' \
+                  'Retry same delete' \
+                  'nuthatch-recursive-delete' \
+                  'URLSearchParams'; do
+                  grep -F "$marker" /tmp/product-asset.js >/dev/null
+                done
+                test "$(
+                  curl --insecure --silent --output /dev/null \
+                    --write-out '%{http_code}' \
+                    "$base/app"
+                )" = 303
+                test "$(
+                  curl --insecure --silent --output /dev/null \
+                    --write-out '%{http_code}' \
+                    "$base/assets/$asset"
+                )" = 303
+
+                product_upload product-browse/Alpha.txt \
+                  81000000-0000-4000-8000-000000000001 alpha \
+                  >/tmp/product-upload.json
+                grep -F '"result":"succeeded"' /tmp/product-upload.json
+                product_upload product-browse/Alpha.txt \
+                  81000000-0000-4000-8000-000000000001 alpha \
+                  >/tmp/product-upload-replay.json
+                grep -F '"result":"succeeded"' \
+                  /tmp/product-upload-replay.json
+                product_upload product-browse/beta.txt \
+                  81000000-0000-4000-8000-000000000002 beta >/dev/null
+                product_upload product-browse/gamma.txt \
+                  81000000-0000-4000-8000-000000000003 gamma >/dev/null
+                curl --insecure --fail --silent --show-error \
+                  --get \
+                  --cookie "$cookies" \
+                  --data-urlencode root=personal \
+                  --data-urlencode prefix=product-browse \
+                  "$base/api/browse" >/tmp/product-page-one.json
+                grep -F '"path":"product-browse/Alpha.txt"' \
+                  /tmp/product-page-one.json
+                grep -F '"path":"product-browse/beta.txt"' \
+                  /tmp/product-page-one.json
+                if grep -F '"path":"product-browse/gamma.txt"' \
+                  /tmp/product-page-one.json; then
+                  exit 1
+                fi
+                continuation="$(
+                  sed -n \
+                    's/.*"continuation":"\([^"]*\)".*/\1/p' \
+                    /tmp/product-page-one.json
+                )"
+                test -n "$continuation"
+                curl --insecure --fail --silent --show-error \
+                  --get \
+                  --cookie "$cookies" \
+                  --data-urlencode root=personal \
+                  --data-urlencode prefix=product-browse \
+                  --data-urlencode "continuation=$continuation" \
+                  "$base/api/browse" >/tmp/product-page-two.json
+                grep -F '"path":"product-browse/gamma.txt"' \
+                  /tmp/product-page-two.json
+
+                product_upload 000-Needle-A.txt \
+                  81000000-0000-4000-8000-000000000004 one >/dev/null
+                product_upload 001-needle-b.txt \
+                  81000000-0000-4000-8000-000000000005 two >/dev/null
+                product_upload 002-filler.txt \
+                  81000000-0000-4000-8000-000000000006 three >/dev/null
+                product_upload 003-needle-after-bound.txt \
+                  81000000-0000-4000-8000-000000000007 four >/dev/null
+                curl --insecure --fail --silent --show-error \
+                  --get \
+                  --cookie "$cookies" \
+                  --data-urlencode root=personal \
+                  --data-urlencode q=NEEDLE \
+                  "$base/api/browse" >/tmp/product-search.json
+                grep -F '"path":"000-Needle-A.txt"' /tmp/product-search.json
+                grep -F '"path":"001-needle-b.txt"' /tmp/product-search.json
+                grep -F '"partial":true' /tmp/product-search.json
+                if grep -F '003-needle-after-bound.txt' \
+                  /tmp/product-search.json; then
+                  exit 1
+                fi
+                printf 'Product asset, pagination, and search probes passed\n'
+
+                for invalid_url in \
+                  "$base/api/browse?root=Personal" \
+                  "$base/api/browse?root=personal&prefix=a//b" \
+                  "$base/api/download?root=personal&path=./file"; do
+                  invalid_status="$(
+                    curl --insecure --silent --output /dev/null \
+                      --write-out '%{http_code}' \
+                      --cookie "$cookies" \
+                      "$invalid_url"
+                  )"
+                  printf 'Canonical rejection status=%s url=%s\n' \
+                    "$invalid_status" "$invalid_url"
+                  test "$invalid_status" = 400
+                done
+                decomposed_path="$(printf 'cafe\314\201.txt')"
+                decomposed_status="$(
+                  curl --insecure --silent --output /dev/null \
+                    --write-out '%{http_code}' \
+                    --get \
+                    --cookie "$cookies" \
+                    --data-urlencode root=personal \
+                    --data-urlencode "path=$decomposed_path" \
+                    "$base/api/download"
+                )"
+                printf 'NFC rejection status=%s\n' "$decomposed_status"
+                test "$decomposed_status" = 400
+                product_upload encoded%252Fname.txt \
+                  81000000-0000-4000-8000-000000000008 encoded \
+                  >/dev/null
+                curl --insecure --fail --silent --show-error \
+                  --cookie "$cookies" \
+                  "$base/api/download?root=personal&path=encoded%252Fname.txt" \
+                  >/tmp/product-encoded
+                test "$(cat /tmp/product-encoded)" = encoded
+                product_upload caf%C3%A9.txt \
+                  81000000-0000-4000-8000-000000000014 unicode \
+                  >/dev/null
+                curl --insecure --fail --silent --show-error \
+                  --cookie "$cookies" \
+                  --dump-header /tmp/product-unicode.headers \
+                  "$base/api/download?root=personal&path=caf%C3%A9.txt" \
+                  >/tmp/product-unicode
+                test "$(cat /tmp/product-unicode)" = unicode
+                grep -i '^content-disposition:' /tmp/product-unicode.headers |
+                  grep -F "filename*=UTF-8''caf%C3%A9.txt" >/dev/null
+                printf 'Product canonical path probes passed\n'
+
+                product_upload active.svg \
+                  81000000-0000-4000-8000-000000000009 \
+                  '<svg onload="alert(1)"></svg>' >/dev/null
+                test "$(
+                  curl --insecure --silent --output /tmp/product-range.json \
+                    --write-out '%{http_code}' \
+                    --cookie "$cookies" \
+                    --header 'Range: bytes=0-1' \
+                    "$base/api/download?root=personal&path=active.svg"
+                )" = 416
+                grep -F '"error":"range_not_supported"' \
+                  /tmp/product-range.json
+                curl --insecure --fail --silent --show-error \
+                  --cookie "$cookies" \
+                  --dump-header /tmp/product-download.headers \
+                  "$base/api/download?root=personal&path=active.svg" \
+                  >/tmp/product-download.svg
+                grep -i '^content-disposition: *attachment;' \
+                  /tmp/product-download.headers |
+                  grep -F "filename*=UTF-8''active.svg" >/dev/null
+                grep -i '^x-content-type-options: *nosniff' \
+                  /tmp/product-download.headers >/dev/null
+                grep -i '^content-security-policy: *sandbox' \
+                  /tmp/product-download.headers >/dev/null
+                grep -F '<svg onload="alert(1)"></svg>' \
+                  /tmp/product-download.svg
+                printf 'Product safe download probes passed\n'
+
+                product_upload delete-tree/a.txt \
+                  81000000-0000-4000-8000-000000000010 a >/dev/null
+                product_upload delete-tree/b.txt \
+                  81000000-0000-4000-8000-000000000011 b >/dev/null
+                product_upload delete-tree/c.txt \
+                  81000000-0000-4000-8000-000000000012 c >/dev/null
+                curl --insecure --fail --silent --show-error \
+                  --get \
+                  --cookie "$cookies" \
+                  --data-urlencode root=personal \
+                  --data-urlencode path=delete-tree \
+                  "$base/api/delete-plan" >/tmp/product-plan-one.json
+                grep -F '"paths":["delete-tree/a.txt","delete-tree/b.txt"]' \
+                  /tmp/product-plan-one.json
+                grep -F '"continuation":' /tmp/product-plan-one.json |
+                  grep -v '"continuation":null' >/dev/null
+                delete_batch_one="$(
+                  printf \
+                    '{"root":"personal","csrf":"%s","items":[{"path":"delete-tree/a.txt","operation_id":"82000000-0000-4000-8000-000000000001"},{"path":"delete-tree/b.txt","operation_id":"82000000-0000-4000-8000-000000000002"}]}' \
+                    "$csrf"
+                )"
+                curl --insecure --fail --silent --show-error \
+                  --cookie "$cookies" \
+                  --header 'Content-Type: application/json' \
+                  --data "$delete_batch_one" \
+                  "$base/api/delete-batch" >/tmp/product-batch-one.json
+                grep -F '"operation_id":"82000000-0000-4000-8000-000000000001"' \
+                  /tmp/product-batch-one.json
+                test "$(
+                  grep -o '"result":"succeeded"' /tmp/product-batch-one.json |
+                    wc -l |
+                    tr -d ' '
+                )" = 2
+                curl --insecure --fail --silent --show-error \
+                  --cookie "$cookies" \
+                  --header 'Content-Type: application/json' \
+                  --data "$delete_batch_one" \
+                  "$base/api/delete-batch" >/tmp/product-batch-replay.json
+                test "$(
+                  grep -o '"result":"succeeded"' \
+                    /tmp/product-batch-replay.json |
+                    wc -l |
+                    tr -d ' '
+                )" = 2
+                product_upload delete-tree/d-concurrent.txt \
+                  81000000-0000-4000-8000-000000000013 d >/dev/null
+                curl --insecure --fail --silent --show-error \
+                  --get \
+                  --cookie "$cookies" \
+                  --data-urlencode root=personal \
+                  --data-urlencode path=delete-tree \
+                  "$base/api/delete-plan" >/tmp/product-plan-restart.json
+                grep -F '"paths":["delete-tree/c.txt","delete-tree/d-concurrent.txt"]' \
+                  /tmp/product-plan-restart.json
+                delete_batch_two="$(
+                  printf \
+                    '{"root":"personal","csrf":"%s","items":[{"path":"delete-tree/c.txt","operation_id":"82000000-0000-4000-8000-000000000003"},{"path":"delete-tree/d-concurrent.txt","operation_id":"82000000-0000-4000-8000-000000000004"}]}' \
+                    "$csrf"
+                )"
+                curl --insecure --fail --silent --show-error \
+                  --cookie "$cookies" \
+                  --header 'Content-Type: application/json' \
+                  --data "$delete_batch_two" \
+                  "$base/api/delete-batch" >/tmp/product-batch-two.json
+                test "$(
+                  grep -o '"result":"succeeded"' /tmp/product-batch-two.json |
+                    wc -l |
+                    tr -d ' '
+                )" = 2
+                curl --insecure --fail --silent --show-error \
+                  --get \
+                  --cookie "$cookies" \
+                  --data-urlencode root=personal \
+                  --data-urlencode path=delete-tree \
+                  "$base/api/delete-plan" >/tmp/product-plan-empty.json
+                grep -F '"paths":[]' /tmp/product-plan-empty.json
+                grep -F '"continuation":null' /tmp/product-plan-empty.json
+                printf 'Product behavior probes passed\n'
+                exit 0
+              fi
+
               if [ "${NUTHATCH_IDEMPOTENCY_MODE:-}" = verify ]; then
                 pod_curl() {
                   destination="$1"
@@ -1162,6 +1462,12 @@ spec:
                   name: @@PROFILE_NAME@@
                   key: NUTHATCH_IDEMPOTENCY_MODE
                   optional: true
+            - name: NUTHATCH_PRODUCT_MODE
+              valueFrom:
+                configMapKeyRef:
+                  name: @@PROFILE_NAME@@
+                  key: NUTHATCH_PRODUCT_MODE
+                  optional: true
             - name: NUTHATCH_IDEMPOTENCY_IP_A
               valueFrom:
                 configMapKeyRef:

tests/kind/wp05-run.sh

@@ -73,6 +73,13 @@ render_application() {
     -e "s|@@S3_ACCESS_KEY@@|$s3_access_key|g" \
     -e "s|@@S3_SECRET_KEY@@|$s3_secret_key|g" \
     "$ROOT/deploy/kubernetes/nuthatch.yaml.in" > "$RUNTIME/wp05-app-$lane.yaml"
+  if [[ "${NUTHATCH_PRODUCT_GATE:-0}" = 1 ]]; then
+    sed -i \
+      -e 's/NUTHATCH_BROWSE_PAGE_SIZE: "200"/NUTHATCH_BROWSE_PAGE_SIZE: "2"/' \
+      -e 's/NUTHATCH_SEARCH_MAX_KEYS: "500"/NUTHATCH_SEARCH_MAX_KEYS: "3"/' \
+      -e 's/NUTHATCH_DELETE_PAGE_SIZE: "100"/NUTHATCH_DELETE_PAGE_SIZE: "2"/' \
+      "$RUNTIME/wp05-app-$lane.yaml"
+  fi
 }
 
 cleanup_application() {
@@ -86,6 +93,20 @@ cleanup_application() {
   rm -f "$RUNTIME/wp05-app-$lane.yaml"
 }
 
+set_product_profile() {
+  local profile="$1"
+  local mode="$2"
+  local profile_file="$RUNTIME/$profile.env"
+  sed -i '/^NUTHATCH_PRODUCT_MODE=/d' "$profile_file"
+  printf 'NUTHATCH_PRODUCT_MODE=%s\n' "$mode" >> "$profile_file"
+  kube create configmap "$profile" \
+    --namespace "$FIXTURE_NAMESPACE" \
+    --from-env-file="$profile_file" \
+    --dry-run=client \
+    --output yaml |
+    kube apply --filename - >/dev/null
+}
+
 acquire_fixture_lock
 OWNS_FIXTURE=true
 setup_fixture durable coordination oidc target
@@ -98,6 +119,9 @@ load_local_image "$APP_IMAGE" "$NERDCTL_NAMESPACE"
 
 while IFS=$'\t' read -r lane coordination oidc target; do
   profile="$(write_lane_profile "$lane" "$coordination" "$oidc" "$target")"
+  if [[ "${NUTHATCH_PRODUCT_GATE:-0}" = 1 ]]; then
+    set_product_profile "$profile" verify
+  fi
   render_application "$lane" "$RUNTIME/$profile.env"
   kube apply --filename "$RUNTIME/wp05-app-$lane.yaml" >/dev/null
   kube --namespace "$FIXTURE_NAMESPACE" rollout status \
@@ -121,6 +145,28 @@ while IFS=$'\t' read -r lane coordination oidc target; do
   printf 'Running lane %s: coordination=%s oidc=%s target=%s\n' \
     "$lane" "$coordination" "$oidc" "$target"
   run_job_manifest "$job" "$RUNTIME/$job.yaml"
+  if [[ "${NUTHATCH_PRODUCT_GATE:-0}" = 1 ]]; then
+    sed -i \
+      's/NUTHATCH_SEARCH_TIMEOUT_MS: "2000"/NUTHATCH_SEARCH_TIMEOUT_MS: "1"/' \
+      "$RUNTIME/wp05-app-$lane.yaml"
+    kube apply --filename "$RUNTIME/wp05-app-$lane.yaml" >/dev/null
+    kube --namespace "$FIXTURE_NAMESPACE" rollout restart \
+      "deployment/nuthatch-$lane" >/dev/null
+    kube --namespace "$FIXTURE_NAMESPACE" rollout status \
+      "deployment/nuthatch-$lane" --timeout=180s
+    set_product_profile "$profile" timeout
+    timeout_job="wp11-timeout-$lane"
+    render_lane_job \
+      "$timeout_job" \
+      "$TESTBED/wp05-job.yaml.in" \
+      "$CURL_LOCAL_IMAGE" \
+      "$profile"
+    sed -i "s|@@LANE@@|$lane|g" "$RUNTIME/$timeout_job.yaml"
+    run_job_manifest "$timeout_job" "$RUNTIME/$timeout_job.yaml"
+    kube --namespace "$FIXTURE_NAMESPACE" delete \
+      "job/$timeout_job" --ignore-not-found >/dev/null
+    rm -f "$RUNTIME/$timeout_job.yaml"
+  fi
   cleanup_application "$lane"
   cleanup_lane_state "$lane" "$coordination" "$oidc" "$target"
   cleanup_lane_resources "$job" "$profile"

web/package.json

@@ -11,7 +11,8 @@
   "scripts": {
     "build": "vite build",
     "check": "svelte-check --tsconfig ./tsconfig.json",
-    "dev": "vite"
+    "dev": "vite",
+    "test": "node --test test/*.test.mjs"
   },
   "dependencies": {
     "svelte": "5.56.6"

web/src/mutations.ts

@@ -0,0 +1,128 @@
+export type Root = 'personal' | 'shared';
+
+export type MutationResult =
+  | 'succeeded'
+  | 'pending'
+  | 'failed'
+  | 'rejected'
+  | 'conflict';
+
+export type DeleteItem = {
+  path: string;
+  operation_id: string;
+};
+
+export type DeleteItemResult = DeleteItem & {
+  result: MutationResult | null;
+  error: string | null;
+};
+
+export type PendingDelete = {
+  root: Root;
+  prefix: string;
+  items: DeleteItem[];
+};
+
+export type MutationFollowup = 'complete' | 'replay' | 'restart';
+
+export type CapturedOperation = {
+  root: Root;
+  path: string;
+  operationId: string;
+};
+
+export function captureOperation(
+  root: Root,
+  path: string,
+  operationId: string
+): CapturedOperation {
+  return { root, path, operationId };
+}
+
+export function mutationFollowup(result: MutationResult): MutationFollowup {
+  if (result === 'succeeded') return 'complete';
+  if (result === 'pending') return 'replay';
+  return 'restart';
+}
+
+export function unfinishedDeleteItems(
+  results: DeleteItemResult[],
+  nextOperationId: () => string
+): DeleteItem[] {
+  return results.flatMap((result) => {
+    if (result.error !== null || result.result === null) {
+      return [{ path: result.path, operation_id: result.operation_id }];
+    }
+    const followup = mutationFollowup(result.result);
+    if (followup === 'complete') return [];
+    return [
+      {
+        path: result.path,
+        operation_id:
+          followup === 'replay' ? result.operation_id : nextOperationId()
+      }
+    ];
+  });
+}
+
+export function encodePendingDelete(
+  root: Root,
+  prefix: string,
+  items: DeleteItem[]
+): string {
+  return JSON.stringify({ root, prefix, items });
+}
+
+export function decodePendingDelete(
+  encoded: string | null,
+  root: Root,
+  prefix: string
+): DeleteItem[] {
+  const saved = readPendingDelete(encoded);
+  if (saved === null || saved.root !== root || saved.prefix !== prefix) return [];
+  return saved.items;
+}
+
+export function readPendingDelete(encoded: string | null): PendingDelete | null {
+  if (encoded === null) return null;
+  try {
+    const saved = JSON.parse(encoded) as {
+      root?: string;
+      prefix?: string;
+      items?: unknown;
+    };
+    if (
+      (saved.root !== 'personal' && saved.root !== 'shared') ||
+      typeof saved.prefix !== 'string' ||
+      !Array.isArray(saved.items) ||
+      !saved.items.every(validDeleteItem)
+    ) {
+      return null;
+    }
+    return {
+      root: saved.root,
+      prefix: saved.prefix,
+      items: saved.items
+    };
+  } catch {
+    return null;
+  }
+}
+
+export function sharedUploadWarning(root: Root, path: string): string | null {
+  if (root !== 'shared') return null;
+  return `Upload “${path}” to shared storage? This may replace a file for every user.`;
+}
+
+export function deleteWarning(root: Root, path: string, isPrefix: boolean): string {
+  if (root === 'shared') {
+    return `Delete shared ${isPrefix ? 'folder' : 'object'} “${path}” for every user?`;
+  }
+  return `Delete ${isPrefix ? 'folder' : 'object'} “${path}”?`;
+}
+
+function validDeleteItem(value: unknown): value is DeleteItem {
+  if (typeof value !== 'object' || value === null) return false;
+  const item = value as Record<string, unknown>;
+  return typeof item.path === 'string' && typeof item.operation_id === 'string';
+}

web/test/mutations.test.mjs

@@ -0,0 +1,96 @@
+import assert from 'node:assert/strict';
+import test from 'node:test';
+import {
+  captureOperation,
+  deleteWarning,
+  decodePendingDelete,
+  encodePendingDelete,
+  mutationFollowup,
+  readPendingDelete,
+  sharedUploadWarning,
+  unfinishedDeleteItems
+} from '../src/mutations.ts';
+
+test('pending mutations replay while terminal failures restart', () => {
+  assert.equal(mutationFollowup('succeeded'), 'complete');
+  assert.equal(mutationFollowup('pending'), 'replay');
+  assert.equal(mutationFollowup('failed'), 'restart');
+  assert.equal(mutationFollowup('rejected'), 'restart');
+  assert.equal(mutationFollowup('conflict'), 'restart');
+});
+
+test('partial delete recovery preserves only unfinished identities', () => {
+  const ids = ['new-failed', 'new-conflict'];
+  const pending = unfinishedDeleteItems(
+    [
+      {
+        path: 'done',
+        operation_id: 'done-id',
+        result: 'succeeded',
+        error: null
+      },
+      {
+        path: 'waiting',
+        operation_id: 'waiting-id',
+        result: 'pending',
+        error: null
+      },
+      {
+        path: 'failed',
+        operation_id: 'failed-id',
+        result: 'failed',
+        error: null
+      },
+      {
+        path: 'conflict',
+        operation_id: 'conflict-id',
+        result: 'conflict',
+        error: null
+      },
+      {
+        path: 'uncertain',
+        operation_id: 'uncertain-id',
+        result: null,
+        error: 'transport interrupted'
+      }
+    ],
+    () => ids.shift()
+  );
+  assert.deepEqual(pending, [
+    { path: 'waiting', operation_id: 'waiting-id' },
+    { path: 'failed', operation_id: 'new-failed' },
+    { path: 'conflict', operation_id: 'new-conflict' },
+    { path: 'uncertain', operation_id: 'uncertain-id' }
+  ]);
+});
+
+test('persisted delete batches survive reload with the same captured root', () => {
+  const items = [{ path: 'folder/file', operation_id: 'operation-1' }];
+  const encoded = encodePendingDelete('shared', 'folder', items);
+  assert.deepEqual(readPendingDelete(encoded), {
+    root: 'shared',
+    prefix: 'folder',
+    items
+  });
+  assert.deepEqual(decodePendingDelete(encoded, 'shared', 'folder'), items);
+  assert.deepEqual(decodePendingDelete(encoded, 'personal', 'folder'), []);
+  assert.deepEqual(decodePendingDelete('{"items":[null]}', 'shared', 'folder'), []);
+});
+
+test('logical mutations capture their root before navigation changes', () => {
+  let root = 'personal';
+  const captured = captureOperation(root, 'folder/file', 'operation-1');
+  root = 'shared';
+  assert.deepEqual(captured, {
+    root: 'personal',
+    path: 'folder/file',
+    operationId: 'operation-1'
+  });
+});
+
+test('shared replacement confirmation is explicit', () => {
+  assert.equal(sharedUploadWarning('personal', 'file'), null);
+  assert.match(sharedUploadWarning('shared', 'file'), /replace a file for every user/);
+  assert.match(deleteWarning('shared', 'folder', true), /for every user/);
+  assert.doesNotMatch(deleteWarning('personal', 'file', false), /every user/);
+});

web/vite.config.ts

@@ -5,7 +5,7 @@ export default defineConfig({
   plugins: [svelte()],
   build: {
     manifest: true,
-    sourcemap: true
+    sourcemap: false
   },
   server: {
     proxy: {