Serialise decoding of large package files

CHANGELOG.md

@@ -5,6 +5,35 @@ the most up-to-date version of this file.
 
 ## Unreleased
 
+## v0.9.11
+
+- Serialise decoding of large package files (@thomashoneyman)
+
+  Rendering any documentation page decodes the entire docs JSON for that
+  package version, which transiently needs tens of times the file's size in
+  heap. A few generated packages (react-icons, elmish-html, deku, ...) have
+  files of 10MB or more with enormous numbers of rarely-cached documentation
+  pages, so a handful of concurrent crawler requests for those pages could
+  exhaust the heap and restart the server. Decodes of files over 5MB now run
+  one at a time; smaller packages (nearly all of them) are unaffected. The
+  file is only read once the lock is held, so queued requests do not pin file
+  contents, and the queue is bounded (excess requests fail fast with a 503
+  rather than accumulating while clients time out). The hourly index
+  regeneration is exempt from the bound so the index never silently omits a
+  package.
+
+- Do not decode a package version's file twice when rendering the package
+  page for the latest version (@thomashoneyman)
+- Disallow SEO/bulk crawlers (Semrush, Ahrefs, DotBot, MJ12, Amazonbot,
+  Bytespider, PetalBot) in robots.txt (@thomashoneyman)
+- Evict page-cache files not accessed in 90 days via a weekly cron job
+  installed by the deploy, so the cache cannot fill the disk
+  (@thomashoneyman)
+- Raise the heap limit to `-M3400m` now that the server has swap to absorb
+  transient spikes above physical RAM (@thomashoneyman)
+- Add `deploy/SERVER.md` documenting server-only and DigitalOcean account
+  state (@thomashoneyman)
+
 ## v0.9.10
 
 - Build the search index one package at a time (@thomashoneyman)

config/robots.txt

@@ -1 +1,26 @@
 User-agent: *
+Disallow:
+
+# SEO and bulk crawlers provide no value to a documentation site and generate
+# most of the traffic to the enormous long tail of uncached package pages,
+# each of which is expensive to render (see Handler.Database.lookupPackage).
+User-agent: SemrushBot
+Disallow: /
+
+User-agent: AhrefsBot
+Disallow: /
+
+User-agent: DotBot
+Disallow: /
+
+User-agent: MJ12bot
+Disallow: /
+
+User-agent: Amazonbot
+Disallow: /
+
+User-agent: Bytespider
+Disallow: /
+
+User-agent: PetalBot
+Disallow: /

deploy/SERVER.md

@@ -0,0 +1,57 @@
+# Server notes for pursuit.purescript.org
+
+This file documents the state that lives only on the server or in the
+DigitalOcean account, which no deploy touches and which would otherwise be
+tribal knowledge. Last verified: 2026-07-05.
+
+## The droplet
+
+- DigitalOcean droplet 177127298 (`pursuit.purescript.org`), s-2vcpu-4gb,
+  nyc1, IP 206.189.189.151.
+- Ubuntu 24.04
+- DNS for purescript.org is managed at Namecheap, not DigitalOcean.
+- The CI runner in `.github/workflows/ci.yml` must build on the same Ubuntu
+  release the server runs, or the binary's glibc requirement won't be
+  satisfiable. Bump both together.
+
+## Server-only state (not managed by deploys)
+
+- **Swap**: 4GB `/swapfile`, registered in `/etc/fstab`, with
+  `vm.swappiness=10` set in `/etc/sysctl.d/99-swappiness.conf`.
+- **Service enablement**: `pursuit` and `nginx` are `systemctl enable`d.
+- **Backups**: root crontab runs `deploy/backup.sh` daily at 13:00 UTC,
+  copying `data/verified/` (the actual database) to `/var/www/pursuit-backups`
+  and pushing to the `purescript/pursuit-backups` GitHub repo. The page cache
+  (`data/cache/`) is *not* backed up; it is pure derived data.
+- **nginx reload cron**: root crontab reloads nginx daily at 12:00 UTC to pick
+  up renewed TLS certificates.
+- **TLS**: certbot (apt package) with the systemd `certbot.timer`; webroot
+  under `/var/www/letsencrypt-webroot`.
+- **Cache eviction**: `/etc/cron.weekly/pursuit-cache-eviction` (installed by
+  `remote.sh` from `deploy/cache-eviction.sh`) deletes cache files not
+  accessed in 90 days so the cache cannot fill the disk.
+
+## DigitalOcean account state
+
+- **Uptime check** `pursuit-search-backend` targets
+  `https://pursuit.purescript.org/search?q=maybe` from us_east and eu_west.
+  The target is deliberately a search URL: search always exercises the
+  backend, whereas package pages are served by nginx from the page cache
+  even when the backend is down (which is how the 2025-26 OOM crash loop
+  went unnoticed for months). One alert: down for 2+ minutes.
+- **Alert policy**: droplet memory utilization above 90% sustained for one
+  hour. This is the early warning that the package database is outgrowing
+  the droplet again.
+- Alerts email *****@thomashoneyman.com.
+
+## Memory background
+
+The whole-package docs JSON is the unit of storage; rendering any single
+documentation page decodes the entire file for that package version, which
+transiently needs tens of times the file size in heap. A few generated
+packages (react-icons, elmish-html, deku, google-apps, ...) have 10-25MB
+files, so concurrent uncached requests for their pages can exhaust the heap.
+`Handler.Database.lookupPackage` therefore serialises decodes of files over
+5MB, and the search index is built one package at a time
+(`createSearchIndexFromDatabase`). If heap-exhaustion restarts reappear in
+the journal (`journalctl -u pursuit | grep "Heap exhausted"`), start there.

deploy/cache-eviction.sh

@@ -0,0 +1,24 @@
+#!/bin/sh
+
+# Evict pursuit page-cache files that nobody has accessed in 90 days, so that
+# the cache (which otherwise grows without bound as crawlers walk the long
+# tail of package documentation pages) cannot fill the disk.
+#
+# This is safe: the cache is pure derived data. Everything in it is rendered
+# from /var/www/pursuit/data/verified, nginx treats a missing cache file as
+# "proxy to the backend", and an evicted page is simply re-rendered and
+# re-cached on the next request for it. Backups do not include the cache.
+#
+# The finds tolerate errors: package uploads clear cache directories
+# concurrently (Handler.Caching.clearCache), so files can vanish mid-walk.
+#
+# Installed to /etc/cron.weekly by deploy/remote.sh.
+
+CACHE_DIR=/var/www/pursuit/data/cache
+
+[ -d "$CACHE_DIR" ] || exit 0
+
+find "$CACHE_DIR" -type f -atime +90 -delete 2>/dev/null || true
+find "$CACHE_DIR" -mindepth 1 -type d -empty -delete 2>/dev/null || true
+
+exit 0

deploy/pursuit.service

@@ -4,10 +4,11 @@ Description=Web service for hosting of PureScript API documentation
 [Service]
 Type=simple
 User=www-data
-# The server has 2 vCPUs and 4GB of RAM. The heap limit needs to leave room
-# for nginx and the rest of the system, so that the RTS runs out of heap
-# before the kernel's OOM killer steps in.
-ExecStart=/usr/local/bin/pursuit +RTS -N2 -A64m -M3G -RTS
+# The server has 2 vCPUs, 4GB of RAM and 4GB of swap. The heap limit needs to
+# leave room for nginx and the rest of the system; spikes above physical RAM
+# are absorbed by swap, and the RTS runs out of heap before the kernel's OOM
+# killer would step in.
+ExecStart=/usr/local/bin/pursuit +RTS -N2 -A64m -M3400m -RTS
 Restart=always
 RestartSec=5s
 Environment="PURSUIT_APPROOT=https://pursuit.purescript.org"

deploy/remote.sh

@@ -56,6 +56,9 @@ rm -r "$tmpdir"
 cp /var/www/pursuit/deploy/nginx.conf /etc/nginx/sites-enabled/pursuit.conf
 systemctl reload nginx
 
+# install cache eviction cron job
+install -m 755 /var/www/pursuit/deploy/cache-eviction.sh /etc/cron.weekly/pursuit-cache-eviction
+
 # install systemd service confing
 cp /var/www/pursuit/deploy/pursuit.service /etc/systemd/system/pursuit.service
 systemctl daemon-reload

pursuit.cabal

@@ -1,5 +1,5 @@
 name:              pursuit
-version:           0.9.10
+version:           0.9.11
 cabal-version:     >= 1.8
 build-type:        Simple
 license:           MIT

src/Application.hs

@@ -59,6 +59,8 @@ makeFoundation appSettings = do
     appHttpManager <- newManager
     appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
     appSearchIndex <- newTVarIO emptySearchIndex
+    appLargeDecodeLock <- newMVar ()
+    appLargeDecodeWaiters <- newTVarIO 0
     let foundation = App{..}
     void (startRegenThread foundation)
     return foundation

src/Foundation.hs

@@ -68,6 +68,12 @@ data App = App
     , appHttpManager    :: Manager
     , appLogger         :: Logger
     , appSearchIndex    :: TVar SearchIndex
+    , appLargeDecodeLock :: MVar ()
+    -- ^ Held while decoding a large package's JSON; see
+    -- 'Handler.Database.lookupPackage'.
+    , appLargeDecodeWaiters :: TVar Int
+    -- ^ The number of threads holding or waiting for 'appLargeDecodeLock',
+    -- used to bound the queue.
     }
 
 instance HasHttpManager App where

src/Handler/Database.hs

@@ -19,7 +19,7 @@ import qualified Data.NonNull as NN
 import qualified Data.Text as T
 import Data.Version (Version, showVersion)
 import System.Directory
-  (getDirectoryContents, getModificationTime, doesDirectoryExist)
+  (getDirectoryContents, getModificationTime, doesDirectoryExist, getFileSize)
 
 import Web.Bower.PackageMeta (PackageName, mkPackageName, runPackageName)
 import qualified Language.PureScript.Docs as D
@@ -68,7 +68,7 @@ createSearchIndexFromDatabase = do
       case mversion of
         Nothing -> return Nothing
         Just version -> do
-          mpkg <- hush <$> lookupPackage name version
+          mpkg <- hush <$> lookupPackageWithPolicy WaitWhenBusy name version
           case mpkg of
             Nothing -> return Nothing
             Just pkg -> do
@@ -89,17 +89,83 @@ data SomethingMissing
   deriving (Show, Eq, Ord)
 
 lookupPackage :: PackageName -> Version -> Handler (Either SomethingMissing D.VerifiedPackage)
-lookupPackage pkgName version = do
+lookupPackage = lookupPackageWithPolicy FailWhenBusy
+
+data LargeDecodePolicy = FailWhenBusy | WaitWhenBusy
+
+lookupPackageWithPolicy :: LargeDecodePolicy -> PackageName -> Version -> Handler (Either SomethingMissing D.VerifiedPackage)
+lookupPackageWithPolicy policy pkgName version = do
   file <- packageVersionFileFor pkgName version
-  mcontents <- liftIO (readFileMay file)
-  case mcontents of
-    Just contents ->
-      Right <$> decodeVerifiedPackageFile file contents
+  msize <- liftIO (catchDoesNotExist (getFileSize file))
+  mpkg <- case msize of
+    Nothing -> return Nothing
+    Just size
+      | size >= largeDecodeThreshold ->
+          withLargeDecodeLock policy (decodeFrom file)
+      | otherwise ->
+          decodeFrom file
+  case mpkg of
+    Just pkg -> return (Right pkg)
     Nothing -> do
       -- Work out whether there's no such package or just no such version
       dir <- packageDirFor pkgName
       dirExists <- liftIO $ doesDirectoryExist dir
       return $ Left $ if dirExists then NoSuchPackageVersion else NoSuchPackage
+  where
+  -- The file is read inside the lock (rather than before queueing for it) so
+  -- that threads waiting their turn do not each pin a copy of a large file's
+  -- bytes. The decoded package is forced before the lock is released; the
+  -- decode is eager in practice, but we make certain the allocation spike
+  -- stays inside the lock.
+  decodeFrom :: String -> Handler (Maybe D.VerifiedPackage)
+  decodeFrom file = do
+    mcontents <- liftIO (readFileMay file)
+    case mcontents of
+      Nothing -> return Nothing
+      Just contents -> do
+        pkg <- decodeVerifiedPackageFile file contents
+        pkg `deepseq` return (Just pkg)
+
+-- | Decoding a package's docs JSON transiently needs tens of times the file's
+-- size in memory, and a few generated packages (react-icons, elmish-html,
+-- deku, ...) have files of 10MB or more, so a handful of concurrent requests
+-- for their (rarely cached, because there are so many of them) documentation
+-- pages can exhaust the heap. Decodes of large files therefore run one at a
+-- time; packages below the threshold - nearly all of them - are unaffected.
+--
+-- The queue for the lock is bounded: once 'maxLargeDecodeWaiters' threads
+-- hold or await the lock, further requests fail fast with a 503 rather than
+-- accumulating without limit while clients time out. The hourly search index
+-- regeneration ('WaitWhenBusy') is exempt from the bound - it must not
+-- silently omit a package from the index just because the server is busy, and
+-- as a single sequential thread it adds at most one waiter.
+withLargeDecodeLock :: LargeDecodePolicy -> Handler a -> Handler a
+withLargeDecodeLock policy action = do
+  app <- getYesod
+  let counter = appLargeDecodeWaiters app
+  admitted <- case policy of
+    WaitWhenBusy -> do
+      atomically (modifyTVar' counter (+ 1))
+      return True
+    FailWhenBusy -> atomically $ do
+      n <- readTVar counter
+      if n >= maxLargeDecodeWaiters
+        then return False
+        else do
+          writeTVar counter (n + 1)
+          return True
+  if admitted
+    then
+      withMVar (appLargeDecodeLock app) (const action)
+        `finally` atomically (modifyTVar' counter (subtract 1))
+    else
+      sendResponseStatus serviceUnavailable503
+        ("Too many concurrent requests for large packages; try again shortly." :: Text)
+  where
+  maxLargeDecodeWaiters = 16 :: Int
+
+largeDecodeThreshold :: Integer
+largeDecodeThreshold = 5 * 1024 * 1024
 
 availableVersionsFor :: PackageName -> Handler [Version]
 availableVersionsFor pkgName = do

src/Handler/Packages.hs

@@ -219,7 +219,12 @@ findPackageWithLatest ::
 findPackageWithLatest pkgName version cont = do
   findPackage pkgName version $ \pkg -> do
     latestVersion <- fromMaybe version <$> getLatestVersionFor pkgName
-    latestPkg <- fromMaybe pkg . hush <$> lookupPackage pkgName latestVersion
+    -- Avoid decoding the same package file twice when the requested version
+    -- is the latest one; for large packages a decode is expensive.
+    latestPkg <-
+      if latestVersion == version
+        then return pkg
+        else fromMaybe pkg . hush <$> lookupPackage pkgName latestVersion
     cont pkg latestPkg
 
 packageNotFound :: PackageName -> Handler a