#!/usr/bin/env stack
> -- stack script --resolver nightly-2025-12-01 --package text --package bytestring --package directory --package filepath --package time --package liquidhaskell --package http-client --package http-client-tls --package http-types --package network

interlog: interactive logs for gopherspace
==========================================

A Venusia applet port of [interlog][repo]. Append-only logs, one per
thread, stored as plain text files; the gopher response is always a
gophermap so menu clients render it as a navigable forum. No daemon,
no database, no schema — just a directory of `.txt` files and one
literate-Haskell script handling index / create / append.

The original was a separate CLI binary (`/usr/bin/interlog`) called
by four distinct `[[gateway]]` routes; this single .lhs replaces all
of them using Venusia 0.8.0.0's path-info dispatch.

[repo]: https://github.com/someodd/interlog

URL design
----------

Below, `$SCRIPT` is whatever `routes.toml` mounts this file at
(e.g. `/applets/interlog/interlog.lhs`). The script reads its own
mount-point from `$selector` at request time, so the layout works
under any `[[files]]` selector.

    $SCRIPT                        → index page (threads newest
                                     first; each is a link — title,
                                     timestamp, size in KB — with a
                                     head/tail content preview and an
                                     "append" prompt; "create new"
                                     search prompt; "browse raw" link)

    $SCRIPT/new + text             → create a new thread; the
                                     search text becomes the opening
                                     message and the first line
                                     becomes the (slugified) title.
                                     Creating a thread past the
                                     'maxLogs' cap prunes the oldest.

    $SCRIPT/append/<id> + text     → append `text` as a new line to
                                     the thread with id `<id>`, unless
                                     the thread has reached its
                                     'maxLogSizeKb' cap, in which case
                                     it's closed to replies.

Raw log content is served by Venusia's existing `[[files]]` block,
not by this script — clicking a thread title in the index goes to
`logs/<filename>` under this directory and Venusia returns the file
verbatim.

Log files live at `./logs/` (relative to the script's directory,
which Venusia sets as the working directory at exec time). They're
named `<id>_<epoch>_<title-slug>.txt`; the directory is created on
first run if it doesn't already exist. The slug is ASCII-only and
underscore-separated (see 'slugify'); since the `id` and `epoch`
fields never contain `_`, 'splitFilename' still recovers the title
even though the slug shares that field separator.

Verifying this applet
---------------------

Two complementary halves, exactly as the gopher-applet spec lays out:

  * `doctest-lhs interlog.lhs` runs the `>>>` examples on every pure
    helper below (slugging, KB rendering, filename parsing, line
    extraction, gophermap row builders). It reuses this file's own
    `-- stack` directive and language pragmas.

  * The LiquidHaskell GHC plugin (enabled via the `OPTIONS_GHC`
    pragma) checks the refinement types inline at *compile* time —
    so `run-cached-lhs` and the shebang path both exercise it on
    every cache miss, no separate command. The refinements here are
    targeted, not a totality proof: the two `--no-*` LIQUID options
    switch off LH's "everything must be proven total and
    terminating" defaults so the recursive directory walk and the
    argv cons-pattern don't need re-architecting, and what's left
    are the specific invariants we *do* want checked:

      - 'maxLogs' and 'maxSlugLen' carry verified @>= 1@ refinements
        — drop either to zero and LH refuses to compile (no logs
        allowed / every slug collapses to "untitled"). 'maxSubmissionKb'
        goes further with a *cross-constant* refinement,
        @1 <= v < maxLogSizeKb@: LH @inline@s 'maxLogSizeKb' into its
        logic, so the per-submission cap is proven both positive and
        strictly below the whole-log cap (above which it could never
        fire). Set either cap to a nonsense value and the compile
        fails.
      - 'asGopherFields' carries a *verified* @len == 4@ refinement
        on its @Just@ result (no @assume@): LH derives it from the
        @length fs == 4@ guard via the @length@/@len@ spec, so the
        four-field gophermap-pass-through match in 'isGophermapRow'
        is total by construction.
      - 'sanitize' is *assumed* to produce 'SafeText' (text with no
        CR/LF/TAB row-break bytes). LH trusts the body; it's six
        characters of `T.map`, audited by the three doctests on it.
      - 'kbOf' is *assumed* to return a non-negative count.

    Per the spec, no LTS-22/23/24 snapshot ships `liquidhaskell`, so
    this file pins `nightly-2025-12-01` on its `-- stack` line; the
    other applets in this directory keep their own resolvers.

Module header and imports
-------------------------

> {-# LANGUAGE OverloadedStrings #-}
> {-# OPTIONS_GHC -fplugin=LiquidHaskell #-}
>
> {-@ LIQUID "--no-totality" @-}
> {-@ LIQUID "--no-termination" @-}
>
> module Main (main) where
>
> import           Control.Exception     (IOException, SomeException, try)
> import qualified Data.ByteString       as BS
> import qualified Data.ByteString.Char8 as BSC
> import           Data.Char             (isAsciiLower, isAsciiUpper, isDigit,
>                                         isSpace, toLower)
> import           Data.List             (intercalate, isPrefixOf, isSuffixOf,
>                                         sortOn)
> import qualified Data.Text             as T
> import qualified Data.Text.Encoding    as TE
> import qualified Data.Text.Encoding.Error as TEE
> import qualified Data.Text.IO          as TIO
> import           Data.Time             (UTCTime, defaultTimeLocale, formatTime)
> import           Data.Time.Clock.POSIX (getPOSIXTime)
> import           System.Directory      (createDirectoryIfMissing, doesDirectoryExist,
>                                         doesFileExist, getFileSize,
>                                         getModificationTime, listDirectory,
>                                         removeFile)
> import           System.Environment    (getArgs, lookupEnv)
> import           System.FilePath       ((</>), takeExtension)
> import           System.IO             (BufferMode (..), IOMode (..),
>                                         hPutStr, hSetBuffering, hSetEncoding,
>                                         stdout, utf8, withFile)
> import           Data.Bits             ((.&.), (.|.), shiftL, shiftR)
> import           Data.Word             (Word8, Word16)
> import           Text.Read             (readMaybe)
> import qualified Network.HTTP.Client     as H
> import qualified Network.HTTP.Client.TLS as HTLS
> import           Network.HTTP.Types.Status (statusCode)
> import           Network.HTTP.Types.Header (hContentType, hContentLength)
> import           Network.Socket        (AddrInfo (..), SockAddr (..),
>                                         getAddrInfo, hostAddressToTuple,
>                                         hostAddress6ToTuple)
> import           System.Timeout        (timeout)
> import           Data.IORef            (newIORef, readIORef, writeIORef)

Constants
---------

`GOPHER_HOST` / `GOPHER_PORT` env vars override the defaults so the
same script works on staging and production without editing. The two
operator knobs are 'maxLogs' (how many threads exist at once) and
'maxLogSizeKb' (how big any one thread may grow); everything else is
derived. The original took limits via env vars (`LOG_MAX_SIZE` etc.),
but for an applet the config-via-env path is awkward — tweak the
constants here instead.

> defaultHost, defaultPort :: T.Text
> defaultHost = "gopher.someodd.zip"
> defaultPort = "70"

> logsDir :: FilePath
> logsDir = "logs"     -- relative to script's CWD (set by Venusia)

The board holds at most 'maxLogs' threads. Creating the (maxLogs+1)th
thread prunes the oldest by mtime — a ring buffer of conversations,
sized to keep the index navigable and the directory bounded.

> -- | Maximum number of threads kept at once; the oldest is pruned
> -- when a new thread pushes the count past it. The @>= 1@ refinement
> -- is verified by LH: a board that can hold zero threads is useless,
> -- so dropping this to 0 fails the compile.
> {-@ maxLogs :: {v:Int | v >= 1} @-}
> maxLogs :: Int
> maxLogs = 64

> -- | Per-log size ceiling, in kilobytes. A log at or above this size
> -- is closed to replies (see 'appendToLog'). It's @inline@d into LH's
> -- logic so 'maxSubmissionKb' can be refined against its value — that
> -- cross-check (@maxSubmissionKb < maxLogSizeKb@) is where this
> -- constant's sanity is enforced: set it to 0 and the submission-cap
> -- refinement fails to compile.
> {-@ inline maxLogSizeKb @-}
> maxLogSizeKb :: Int
> maxLogSizeKb = 1024     -- 1 MiB

> -- | The per-thread ceiling in bytes, derived from 'maxLogSizeKb'.
> maxLogSizeBytes :: Int
> maxLogSizeBytes = maxLogSizeKb * 1024

> -- | Per-submission size ceiling, in kilobytes — the cap on a single
> -- create or append. Gopher (RFC 1436) puts no limit on the query a
> -- client may send: it's a bare @CR LF@-terminated string, and any
> -- ceiling is the daemon's read buffer, not a guarantee we can lean
> -- on or get a clean error from. So we enforce our own and reject an
> -- over-long submission with a clear message. It also stops one post
> -- from filling a whole log, since a post is now one line on disk.
> --
> -- The refinement is the cross-constant one: LH *verifies*
> -- @1 <= v < maxLogSizeKb@ against the @inline@d 'maxLogSizeKb', so a
> -- per-post cap that's non-positive, or that meets/exceeds the
> -- whole-log cap (where it could never actually fire), fails to
> -- compile.
> {-@ maxSubmissionKb :: {v:Int | 1 <= v && v < maxLogSizeKb} @-}
> maxSubmissionKb :: Int
> maxSubmissionKb = 64

> -- | The per-submission ceiling in bytes, derived from 'maxSubmissionKb'.
> maxSubmissionBytes :: Int
> maxSubmissionBytes = maxSubmissionKb * 1024

The index shows a content preview of each thread, by *whole lines* so
no post is ever cut mid-line. A thread of at most 'previewHeadLines' +
'previewTailLines' lines is shown whole; a longer one shows its first
'previewHeadLines' lines, a marker naming how many lines (and bytes)
were skipped, then its last 'previewTailLines' lines.

> previewHeadLines, previewTailLines :: Int
> previewHeadLines = 5     -- preview: whole lines shown from the start
> previewTailLines = 5     -- preview: whole lines shown from the end

Request parsing
---------------

Three argv from Venusia: selector, search, path-info. Cons-pattern
parsing ignores extras and aborts loudly on empty argv (the script
can't invent its own mount-point selector — see figlet.lhs's
fallback-selector commentary for the same reasoning).

> data Req = Req
>   { reqSel :: T.Text  -- $selector
>   , reqQ   :: T.Text  -- $search
>   , reqP   :: T.Text  -- $pathinfo
>   } deriving Show

The argv catch-all calls `error`, which LH's totality checker would
flag even with `--no-totality` off in some configurations; it's pure
plumbing with nothing to refine, so we `ignore` it outright (same as
grep.lhs does for its own `parseArgs`).

> {-@ ignore parseArgs @-}
> parseArgs :: [String] -> Req
> parseArgs (s:q:p:_) = Req (T.pack s) (T.pack q) (T.pack p)
> parseArgs (s:q:_)   = Req (T.pack s) (T.pack q) T.empty
> parseArgs [s]       = Req (T.pack s) T.empty    T.empty
> parseArgs []        = error
>   "interlog.lhs: missing argv[0] (gopher selector). Run via Venusia, \
>   \or for manual testing pass selector + search + path-info explicitly."

> data Ctx = Ctx
>   { ctxScriptSel :: T.Text   -- selector path to this script, no path-info
>   , ctxHost      :: T.Text
>   , ctxPort      :: T.Text
>   }

Main dispatch
-------------

Split path-info into segments and route. Search text is the message
body for create / append; empty search just re-prompts.

Top-level `main` wraps the real work in `try` so an uncaught
exception (permission denied, IO error, anything else) becomes a
visible type-3 gophermap response instead of a blank body — blank
output is the worst possible failure mode for a gopher client to
present. `hSetEncoding stdout utf8` forces UTF-8 regardless of the
daemon's locale, so the menu rows that contain Unicode (em-dashes,
arrows) never silently fail mid-write.

> main :: IO ()
> main = do
>   hSetBuffering stdout NoBuffering
>   hSetEncoding  stdout utf8
>   createDirectoryIfMissing True logsDir
>   result <- try mainBody :: IO (Either SomeException ())
>   case result of
>     Right () -> pure ()
>     Left e   -> mapM_ putLine
>       [ errorItem ("interlog crashed: " <> T.pack (show e))
>       , terminator
>       ]

> mainBody :: IO ()
> mainBody = do
>   req  <- parseArgs <$> getArgs
>   host <- maybe defaultHost T.pack <$> lookupEnv "GOPHER_HOST"
>   port <- maybe defaultPort T.pack <$> lookupEnv "GOPHER_PORT"
>   let pinfo     = reqP req
>       scriptSel = T.dropEnd (T.length pinfo) (reqSel req)
>       ctx       = Ctx scriptSel host port
>       segs      = filter (not . T.null) . T.splitOn "/" $ pinfo
>       msg       = T.strip (reqQ req)
>       hasMsg    = not (T.null msg)
>   case T.stripPrefix "/extimg/" pinfo of
>     Just rest -> emitExtImg ctx (decodeExtImgPath rest)
>     Nothing   -> case (segs, hasMsg) of
>       ([],                     _    ) -> emitIndex ctx
>       (["new"],                False) -> emitNewPrompt ctx
>       (["new"],                True ) -> handleNew    ctx msg
>       (["append", lid],        False) -> emitAppendPrompt ctx lid
>       (["append", lid],        True ) -> handleAppend ctx lid msg
>       (["view",   lid],        _    ) -> emitThread ctx lid
>       (["img",    lid, n],     _    ) -> emitImage  ctx lid n
>       (["faq"],                _    ) -> emitFaq ctx
>       _                                 -> emitPathError ctx pinfo

Gophermap line builders
-----------------------

Same conventions as the other applets in this directory. Every row
ends with `\r\n`; every display field passes through `sanitize`.

> putLine :: T.Text -> IO ()
> putLine t = TIO.putStr (t <> "\r\n")

> -- | >>> infoLine "hello"
> -- "ihello\tnull\terror.host\t1"
> infoLine :: T.Text -> T.Text
> infoLine msg = "i" <> sanitize msg <> "\tnull\terror.host\t1"

> -- | >>> menuLine "home" "/" "host" "70"
> -- "1home\t/\thost\t70"
> menuLine :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text
> menuLine display sel host port =
>   "1" <> sanitize display <> "\t" <> sel <> "\t" <> host <> "\t" <> port

> -- | >>> textLine "doc" "/d" "host" "70"
> -- "0doc\t/d\thost\t70"
> textLine :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text
> textLine display sel host port =
>   "0" <> sanitize display <> "\t" <> sel <> "\t" <> host <> "\t" <> port

> -- | >>> searchLine "find" "/q" "host" "70"
> -- "7find\t/q\thost\t70"
> searchLine :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text
> searchLine display sel host port =
>   "7" <> sanitize display <> "\t" <> sel <> "\t" <> host <> "\t" <> port

> -- | A type-h "URL" line — clients with web support open it in a
> -- browser; gopher-only clients fall back gracefully.
> --
> -- >>> urlLine "Source" "https://example.com" "host" "70"
> -- "hSource\tURL:https://example.com\thost\t70"
> urlLine :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text
> urlLine display url host port =
>   "h" <> sanitize display <> "\tURL:" <> url <> "\t" <> host <> "\t" <> port

> -- | An image menu row (item type @I@). The selector points at this
> -- script's @/img/<id>/<n>@ endpoint, which serves the decoded bytes.
> --
> -- >>> imageLine "pic" "/applets/interlog/interlog.lhs/img/abc/0" "host" "70"
> -- "Ipic\t/applets/interlog/interlog.lhs/img/abc/0\thost\t70"
> imageLine :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text
> imageLine display sel host port =
>   "I" <> sanitize display <> "\t" <> sel <> "\t" <> host <> "\t" <> port

> -- | A menu row of an arbitrary gopher item type — used when forwarding
> -- a @gopher://host[:port]/<type><selector>@ URL as a cross-server
> -- link, so the row carries the same item type the URI declared.
> --
> -- >>> typedLine '0' "Notes" "/notes.txt" "host" "70"
> -- "0Notes\t/notes.txt\thost\t70"
> typedLine :: Char -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text
> typedLine t display sel host port =
>   T.singleton t <> sanitize display <> "\t" <> sel <> "\t" <> host <> "\t" <> port

> -- | >>> errorItem "nope"
> -- "3nope\tnull\terror.host\t1"
> errorItem :: T.Text -> T.Text
> errorItem msg = "3" <> sanitize msg <> "\tnull\terror.host\t1"

> terminator :: T.Text
> terminator = "."

Gophermap pass-through
----------------------

A stored line that is *itself* a syntactically valid gophermap row is
emitted to the menu verbatim, so a user can post a real link or menu
entry into a thread. The shape is:

    <type><label> \t <selector> \t <host> \t <port>

— exactly four TAB-separated fields, the first beginning with a known
gopher item type, the last all digits. The safety boundary that makes
raw pass-through acceptable: 'prepareLine' has already stripped CR/LF
from every stored line, so a line that validates here can only ever be
ONE wire row — it cannot smuggle extra rows, a terminator, or break out
of its preview block. A line that fails *any* check falls back to a
sanitised info line, the conservative default.

Authoring such a row from a gopher client is the catch: the protocol
uses TAB to split the selector from the search string, so a query
can't carry a literal TAB. 'unescape' bridges that — a user types
@\\t@ for each field separator (e.g. @0My link\\t/sel\\thost\\t70@) and
'prepareLine' turns those into real tabs at write time. There is
deliberately no @\\n@ escape: that would reintroduce the row-break a
client otherwise cannot inject.

This is the LiquidHaskell showcase the rest of the file builds toward:
'asGopherFields' carries a *verified* (not assumed) refinement — its
@Just@ result is statically guaranteed to hold exactly four fields,
because LH's @length@ spec ties the @length fs == 4@ guard to the
@len v == 4@ measure on the result. The four-field 'isGophermapRow'
pattern match is therefore total by construction.

> -- | Gopher item-type characters accepted as the first byte of a
> -- pass-through row: RFC 1436's set (@0@-@9@, @+@, @g@, @I@, @T@) plus
> -- the common extensions (@h@ HTML, @i@ info, @s@ sound, @;@ video,
> -- @d@ document, @p@ image, @c@ calendar, @e@ event, @M@ MIME, @P@ PDF).
> itemTypeChars :: String
> itemTypeChars = "0123456789+gIThis;dpcMeP"

> -- | Accept a tab-split line only when it has exactly four fields. The
> -- @Just@ result is refined to @len == 4@, which LH *verifies* (no
> -- @assume@) straight from the four-element pattern — so callers may
> -- match four fields without the partial match being a real risk.
> -- (Matching @[_,_,_,_]@ rather than testing @length@ keeps the proof
> -- structural: @len@ is a list measure LH reasons about directly,
> -- where @Data.Foldable.length@ would need its own bridging spec.)
> --
> -- >>> asGopherFields ["a","b","c","d"]
> -- Just ["a","b","c","d"]
> --
> -- >>> asGopherFields ["a","b","c"]
> -- Nothing
> --
> -- >>> asGopherFields []
> -- Nothing
> {-@ asGopherFields :: [T.Text] -> Maybe {v:[T.Text] | len v == 4} @-}
> asGopherFields :: [T.Text] -> Maybe [T.Text]
> asGopherFields fs@[_, _, _, _] = Just fs
> asGopherFields _               = Nothing

> -- | Is this line a single, well-formed gophermap row? Exactly four
> -- tab fields; the first nonempty and beginning with a known item
> -- type; the port nonempty and all ASCII digits.
> --
> -- >>> isGophermapRow "0Cool gopherhole\t/cool\texample.com\t70"
> -- True
> --
> -- >>> isGophermapRow "ian info line is a valid row too\tnull\terror.host\t1"
> -- True
> --
> -- >>> isGophermapRow "just a normal reply with no tabs"
> -- False
> --
> -- >>> isGophermapRow "0only\ttwo\tfields"
> -- False
> --
> -- >>> isGophermapRow "0bad port\t/sel\thost\tseventy"
> -- False
> --
> -- >>> isGophermapRow "Zunknown type\t/sel\thost\t70"
> -- False
> --
> -- >>> isGophermapRow ""
> -- False
> isGophermapRow :: T.Text -> Bool
> isGophermapRow line = case asGopherFields (T.splitOn "\t" line) of
>   Just [f1, _sel, _host, port] ->
>        not (T.null f1)
>     && T.head f1 `elem` itemTypeChars
>     && not (T.null port)
>     && T.all (\c -> c >= '0' && c <= '9') port
>   _ -> False

> -- | The text a new log's title (and so its filename slug) is derived
> -- from. Normally the opening line as-is — but when that line is a
> -- gophermap row, its *display label* instead: field 1 minus the
> -- leading item-type char. So opening a log with a menu line like
> -- @IDisplay Text\t/hello.jpg\tgopher.org\t70@ titles it from
> -- "Display Text", not the whole wire row (which would drag the type
> -- char, selector, host, and port into the slug). Only the slug uses
> -- this; the duplicate-opening check still compares whole lines, so
> -- two different links that happen to share a label don't collide.
> --
> -- >>> titleSource "Just my thoughts for today"
> -- "Just my thoughts for today"
> --
> -- >>> titleSource "IDisplay Text\t/hello.jpg\tgopher.org\t70"
> -- "Display Text"
> --
> -- >>> titleSource "0not a full row\tonly two fields"
> -- "0not a full row\tonly two fields"
> titleSource :: T.Text -> T.Text
> titleSource line = case (isGophermapRow line, T.splitOn "\t" line) of
>   (True, f1 : _) -> T.drop 1 f1
>   _              -> line

Inline base64 images
--------------------

A stored line of the form @img:<base64>@ carries a complete, small
image inline. The renderer turns such a line into an image menu row
('imageLine') whose selector hits this script's @/img/<id>/<n>@
endpoint; that endpoint base64-decodes the same line and writes the
raw bytes back. The base64 alphabet contains no TAB, CR, LF, or
backslash, so 'prepareLine' and 'sanitize' leave an @img:@ line
untouched, and it can never be mistaken for a gophermap row (no tabs
→ not four fields).

Decoding is strict and total: a malformed alphabet, bad padding, or a
length that isn't a multiple of four yields 'Nothing'. Combined with a
magic-byte check *and* a trailer check ('imageComplete'), that lets us
detect a truncated post — the real failure mode, since Venusia caps a
request at the server's configured @request_buffer_bytes@ (8192 on this
host) and silently chops anything longer.

> imgPrefix :: T.Text
> imgPrefix = "img:"

> -- | The whole gopher request — @selector TAB search CR LF@ — must
> -- fit in a single read: Venusia serves each connection with one
> -- @recv sock cfg.requestBufferBytes@ (src/Venusia/Server.hs,
> -- @handleConnHotReload@) and never loops, so anything past this many
> -- bytes is silently dropped. An @img:@ post that overruns it arrives
> -- truncated and fails the completeness check in 'appendToLog'; the
> -- create/append prompts show how much room a given selector leaves.
> --
> -- This MUST equal @request_buffer_bytes@ in this host's
> -- @/var/gopher/venusia.toml@ @[server]@ table (currently 8192). It is
> -- advisory only — used to compute the budget prompts, never enforced
> -- on the wire — so if it drifts /above/ the server's real buffer the
> -- prompts promise room that gets silently chopped, and /below/ it they
> -- under-sell. (Venusia 0.12.0.0 made the buffer configurable and raised
> -- its default 1024 → 4096; this host overrides it to 8192.)
> {-@ venusiaRequestLimit :: {v:Int | v >= 1} @-}
> venusiaRequestLimit :: Int
> venusiaRequestLimit = 8192

> -- | UTF-8 byte length of a 'T.Text' — the 'utf8Len' peer for 'T.Text',
> -- used to size a selector against 'venusiaRequestLimit'.
> --
> -- >>> tBytes "abc"
> -- 3
> tBytes :: T.Text -> Int
> tBytes = BS.length . TE.encodeUtf8

> -- | Bytes of search text a selector leaves under the request cap: the
> -- cap, minus the selector, minus the one TAB that separates them. (A
> -- trailing CR LF can be truncated harmlessly; the body survives as
> -- long as @selector + TAB + body <= venusiaRequestLimit@.)
> --
> -- >>> searchBudget "/applets/interlog/interlog.lhs/append/0123456789"
> -- 8143
> searchBudget :: T.Text -> Int
> searchBudget sel = venusiaRequestLimit - tBytes sel - 1

> -- | Of a given search budget, the raw image bytes an @img:@ post can
> -- carry: drop the @img:@ prefix, then base64 packs 3 bytes per 4
> -- characters, so round down to a whole quad.
> --
> -- >>> imageBudget 975
> -- 726
> --
> -- >>> imageBudget 4
> -- 0
> imageBudget :: Int -> Int
> imageBudget searchBytes = max 0 (((searchBytes - T.length imgPrefix) `div` 4) * 3)

> -- | The advisory info lines the create/append prompts show for a given
> -- submission selector: the request cap, what this selector leaves for
> -- the body, and the resulting inline-image budget. Computed from the
> -- real selector, so the numbers are correct per request automatically.
> budgetLines :: T.Text -> [T.Text]
> budgetLines sel =
>   [ infoLine ("Venusia caps a request at " <> T.pack (show venusiaRequestLimit)
>               <> " bytes (selector + tab + your text).")
>   , infoLine ("This selector is " <> T.pack (show (tBytes sel))
>               <> " bytes, so your text can be up to "
>               <> T.pack (show (searchBudget sel)) <> " bytes.")
>   , infoLine ("Inline image: paste  img:<base64>  (base64 -w0 pic.png) — up to ~"
>               <> T.pack (show (imageBudget (searchBudget sel)))
>               <> " bytes of image here.")
>   ]

> -- | The sextet value of a base64 alphabet character, or 'Nothing'
> -- for anything outside @[A-Za-z0-9+/]@ (padding @=@ is handled by
> -- the quad decoder, not here).
> --
> -- >>> map b64Val "AZaz09+/="
> -- [Just 0,Just 25,Just 26,Just 51,Just 52,Just 61,Just 62,Just 63,Nothing]
> b64Val :: Char -> Maybe Int
> b64Val c
>   | isAsciiUpper c = Just (fromEnum c - fromEnum 'A')
>   | isAsciiLower c = Just (fromEnum c - fromEnum 'a' + 26)
>   | isDigit c      = Just (fromEnum c - fromEnum '0' + 52)
>   | c == '+'       = Just 62
>   | c == '/'       = Just 63
>   | otherwise      = Nothing

> -- | Split a string into 4-character chunks (the caller guarantees a
> -- length that is a multiple of four, so no short tail appears).
> --
> -- >>> chunk4 "abcdefgh"
> -- ["abcd","efgh"]
> --
> -- >>> chunk4 ""
> -- []
> chunk4 :: String -> [String]
> chunk4 [] = []
> chunk4 xs = take 4 xs : chunk4 (drop 4 xs)

> -- | Assemble the 1–3 output bytes from base64 sextet values (each
> -- @0..63@). Top-level so all 'decodeQuad' equations can share them.
> b64Byte1, b64Byte2, b64Byte3 :: Int -> Int -> Word8
> b64Byte1 x y = fromIntegral ((x `shiftL` 2) .|. (y `shiftR` 4))
> b64Byte2 y z = fromIntegral (((y .&. 15) `shiftL` 4) .|. (z `shiftR` 2))
> b64Byte3 z w = fromIntegral (((z .&. 3)  `shiftL` 6) .|.  w)

> -- | Decode one 4-character base64 quad to its 1–3 bytes. Padding
> -- (@=@) is accepted only in the tail positions: @xx==@ → 1 byte,
> -- @xxx=@ → 2 bytes, @xxxx@ → 3 bytes; any other @=@ placement, or a
> -- non-alphabet character, yields 'Nothing' (the @b64Val '='@ lookups
> -- fail for a stray @=@).
> decodeQuad :: String -> Maybe [Word8]
> decodeQuad [a, b, '=', '='] = do
>   x <- b64Val a
>   y <- b64Val b
>   Just [b64Byte1 x y]
> decodeQuad [a, b, c, '='] = do
>   x <- b64Val a
>   y <- b64Val b
>   z <- b64Val c
>   Just [b64Byte1 x y, b64Byte2 y z]
> decodeQuad [a, b, c, d] = do
>   x <- b64Val a
>   y <- b64Val b
>   z <- b64Val c
>   w <- b64Val d
>   Just [b64Byte1 x y, b64Byte2 y z, b64Byte3 z w]
> decodeQuad _ = Nothing

> -- | Decode a list of quads; @=@ padding is only legal in the final
> -- quad, so any earlier quad containing @=@ is rejected.
> decodeQuads :: [String] -> Maybe [Word8]
> decodeQuads []       = Just []
> decodeQuads [q]      = decodeQuad q
> decodeQuads (q : qs)
>   | '=' `elem` q = Nothing
>   | otherwise    = (++) <$> decodeQuad q <*> decodeQuads qs

> -- | The sextet-to-character map for url-safe base64 (RFC 4648 §5):
> -- A–Z = 0–25, a–z = 26–51, 0–9 = 52–61, @-@ = 62, @_@ = 63.
> b64UrlChar :: Int -> Char
> b64UrlChar n
>   | n < 26    = toEnum (fromEnum 'A' + n)
>   | n < 52    = toEnum (fromEnum 'a' + n - 26)
>   | n < 62    = toEnum (fromEnum '0' + n - 52)
>   | n == 62   = '-'
>   | otherwise = '_'

> -- | Url-safe base64 encode (no padding). Used to pack a URL into a
> -- single gopher-selector segment so strict clients (Lagrange) don't
> -- choke on @://@ inside the selector.
> --
> -- >>> encodeBase64Url ""
> -- ""
> --
> -- >>> encodeBase64Url "f"
> -- "Zg"
> --
> -- >>> encodeBase64Url "hello"
> -- "aGVsbG8"
> {-@ ignore encodeBase64Url @-}
> encodeBase64Url :: BS.ByteString -> T.Text
> encodeBase64Url = T.pack . go . BS.unpack
>   where
>     go []          = ""
>     go [x]         =
>       let a  = fromIntegral x :: Int
>           c1 = a `shiftR` 2
>           c2 = (a .&. 0x3) `shiftL` 4
>       in [b64UrlChar c1, b64UrlChar c2]
>     go [x, y]      =
>       let a  = fromIntegral x :: Int
>           b  = fromIntegral y :: Int
>           c1 = a `shiftR` 2
>           c2 = ((a .&. 0x3) `shiftL` 4) .|. (b `shiftR` 4)
>           c3 = (b .&. 0xf) `shiftL` 2
>       in [b64UrlChar c1, b64UrlChar c2, b64UrlChar c3]
>     go (x : y : z : rest) =
>       let a  = fromIntegral x :: Int
>           b  = fromIntegral y :: Int
>           c  = fromIntegral z :: Int
>           c1 = a `shiftR` 2
>           c2 = ((a .&. 0x3) `shiftL` 4) .|. (b `shiftR` 4)
>           c3 = ((b .&. 0xf) `shiftL` 2) .|. (c `shiftR` 6)
>           c4 = c .&. 0x3f
>       in b64UrlChar c1 : b64UrlChar c2 : b64UrlChar c3 : b64UrlChar c4 : go rest

> -- | Url-safe base64 decode, accepting the no-padding form by adding
> -- @=@ back as needed and then routing through 'decodeBase64'.
> --
> -- >>> decodeBase64Url "aGVsbG8"
> -- Just "hello"
> --
> -- >>> decodeBase64Url "Zg"
> -- Just "f"
> --
> -- >>> decodeBase64Url "not base64!"
> -- Nothing
> decodeBase64Url :: T.Text -> Maybe BS.ByteString
> decodeBase64Url t =
>   let trans  = T.map fwd t
>       padded = case T.length trans `mod` 4 of
>                  2 -> trans <> "=="
>                  3 -> trans <> "="
>                  _ -> trans
>   in decodeBase64 padded
>   where
>     fwd '-' = '+'
>     fwd '_' = '/'
>     fwd c   = c

> -- | Strict, total base64 decode. 'Nothing' unless the input is
> -- non-empty, a multiple of four characters, drawn from the base64
> -- alphabet, and correctly padded.
> --
> -- >>> decodeBase64 "aGVsbG8="
> -- Just "hello"
> --
> -- >>> decodeBase64 "QQ=="
> -- Just "A"
> --
> -- >>> decodeBase64 "not base64!"
> -- Nothing
> --
> -- >>> decodeBase64 ""
> -- Nothing
> {-@ ignore decodeBase64 @-}
> decodeBase64 :: T.Text -> Maybe BS.ByteString
> decodeBase64 t =
>   let s = T.unpack (T.strip t)
>   in if null s || length s `mod` 4 /= 0
>        then Nothing
>        else BS.pack <$> decodeQuads (chunk4 s)

> data ImageKind = PNG | GIF | JPEG deriving (Eq, Show)

> -- | Identify an image by its leading magic bytes.
> --
> -- >>> imageKind (BS.pack [0x89,0x50,0x4e,0x47,0x0d,0x0a,0x1a,0x0a])
> -- Just PNG
> --
> -- >>> imageKind (BSC.pack "GIF89a....")
> -- Just GIF
> --
> -- >>> imageKind (BSC.pack "hello")
> -- Nothing
> imageKind :: BS.ByteString -> Maybe ImageKind
> imageKind bs
>   | BS.pack [0x89,0x50,0x4e,0x47,0x0d,0x0a,0x1a,0x0a] `BS.isPrefixOf` bs = Just PNG
>   | BSC.pack "GIF87a" `BS.isPrefixOf` bs                                 = Just GIF
>   | BSC.pack "GIF89a" `BS.isPrefixOf` bs                                 = Just GIF
>   | BS.pack [0xff,0xd8,0xff] `BS.isPrefixOf` bs                          = Just JPEG
>   | otherwise                                                           = Nothing

> -- | Does the byte stream end with the expected trailer for its kind?
> -- PNG ends with the IEND chunk + its CRC, GIF with @0x3B@, JPEG with
> -- the EOI marker @FF D9@. A truncated upload fails this — that's how
> -- we reject a post Venusia chopped at the request-buffer limit
> -- ('venusiaRequestLimit', 8192 bytes on this host).
> --
> -- >>> imageComplete GIF (BS.pack [0x3b])
> -- True
> --
> -- >>> imageComplete GIF (BS.pack [0x00])
> -- False
> --
> -- >>> imageComplete JPEG (BS.pack [0xff,0xd9])
> -- True
> imageComplete :: ImageKind -> BS.ByteString -> Bool
> imageComplete PNG  bs = BS.pack [0x49,0x45,0x4e,0x44,0xae,0x42,0x60,0x82] `BS.isSuffixOf` bs
> imageComplete GIF  bs = BS.pack [0x3b] `BS.isSuffixOf` bs
> imageComplete JPEG bs = BS.pack [0xff,0xd9] `BS.isSuffixOf` bs

> -- | Classify a stored line as a complete inline image, or 'Nothing'.
> -- The single audited path shared by the renderer, the append
> -- validator, and the @/img@ endpoint.
> --
> -- >>> classifyImageLine "just a normal reply"
> -- Nothing
> --
> -- >>> classifyImageLine "img:not base64"
> -- Nothing
> classifyImageLine :: T.Text -> Maybe (ImageKind, BS.ByteString)
> classifyImageLine line = do
>   rest  <- T.stripPrefix imgPrefix line
>   bytes <- decodeBase64 rest
>   kind  <- imageKind bytes
>   if imageComplete kind bytes then Just (kind, bytes) else Nothing

URL-as-image lines
------------------

A stored line that is *just* a URL to an image presents as a real
image row in the menu. HTTP(S) URLs route through our own
'/extimg/<url>' selector, which streams the remote response body
back to the client (never writing it to disk). Gopher URLs become
cross-server @I@ rows pointing straight at the remote server — no
traffic touches us. Detection is purely shape-based (scheme +
extension), so no fetch happens at post time.

> -- | A URL post parsed from a stored line, classified by scheme and
> -- (for gopher) by the type char the URI declares. The renderer
> -- decides representation: image URLs stream through @/extimg@;
> -- non-image HTTP(S) URLs become @h URL:@ rows; gopher URLs become a
> -- menu row of whatever item-type char their selector carries.
> data UrlPost
>   = HttpUrl   T.Text T.Text                       -- url, label
>   | GopherUrl Char T.Text T.Text T.Text T.Text    -- type, host, port, sel, label
>   deriving (Eq, Show)

> -- | Path (or URL) ends in an image-y extension, case-insensitive,
> -- after stripping any @?query@ or @#fragment@ tail.
> --
> -- >>> hasImageExt "https://x.com/a/b.PNG"
> -- True
> --
> -- >>> hasImageExt "https://x.com/a.png?v=2#x"
> -- True
> --
> -- >>> hasImageExt "https://x.com/page.html"
> -- False
> hasImageExt :: T.Text -> Bool
> hasImageExt url =
>   let bare = T.takeWhile (\c -> c /= '?' && c /= '#') url
>       low  = T.toLower bare
>   in any (`T.isSuffixOf` low) [".png", ".gif", ".jpg", ".jpeg", ".webp"]

> -- | Parse a @gopher://host[:port]/<type><selector>@ URL into the
> -- parts needed to emit a cross-server menu row of that item type.
> -- Rejects userinfo (@\@@ in authority); any type char is accepted
> -- (the URI carries its own type).
> --
> -- >>> parseGopherUrl "gopher://host.tld/Ipics/cat.png"
> -- Just ('I',"host.tld","70","/pics/cat.png")
> --
> -- >>> parseGopherUrl "gopher://host.tld:7070/0notes.txt"
> -- Just ('0',"host.tld","7070","/notes.txt")
> --
> -- >>> parseGopherUrl "gopher://u:p@host/Icat.png"
> -- Nothing
> parseGopherUrl :: T.Text -> Maybe (Char, T.Text, T.Text, T.Text)
> parseGopherUrl t = do
>   rest <- T.stripPrefix "gopher://" t
>   let (hostport, path) = T.break (== '/') rest
>   if T.any (== '@') hostport then Nothing else do
>     let (host, port) = case T.break (== ':') hostport of
>           (h, p) | T.length p > 1 -> (h, T.drop 1 p)
>           _                       -> (hostport, "70")
>     if T.null host then Nothing else do
>       afterSlash <- T.stripPrefix "/" path
>       (typeC, sel0) <- T.uncons afterSlash
>       let sel = if T.null sel0
>                   then "/"
>                   else if "/" `T.isPrefixOf` sel0 then sel0 else "/" <> sel0
>       Just (typeC, host, port, sel)

> -- | Classify a stored line carrying a URL (HTTP(S) or gopher), plus
> -- a label drawn from any text around the URL. The line may be JUST a
> -- URI (label @""@) or a URI embedded in text — "check out this meme
> -- https://x.com/a.png" yields the URL with that surrounding text as
> -- the label. The scheme must appear at the start of the line or
> -- after whitespace (so "abchttps://…" isn't a match), and trailing
> -- sentence punctuation (@.,;:!?)@) is stripped from the URL before
> -- validation.
> --
> -- Image-vs-link is decided at render time by 'hasImageExt' (HTTP) or
> -- by the gopher type char (already in the URI).
> --
> -- >>> classifyUrlLine "https://x.com/a.png"
> -- Just (HttpUrl "https://x.com/a.png" "")
> --
> -- >>> classifyUrlLine "check out this meme https://x.com/a.png"
> -- Just (HttpUrl "https://x.com/a.png" "check out this meme")
> --
> -- >>> classifyUrlLine "read this https://x.com/article"
> -- Just (HttpUrl "https://x.com/article" "read this")
> --
> -- >>> classifyUrlLine "see notes gopher://host/0notes.txt"
> -- Just (GopherUrl '0' "host" "70" "/notes.txt" "see notes")
> --
> -- >>> classifyUrlLine "abchttps://x.com/a.png"
> -- Nothing
> --
> -- >>> classifyUrlLine "no url here"
> -- Nothing
> classifyUrlLine :: T.Text -> Maybe UrlPost
> classifyUrlLine line =
>   let t = T.strip line
>       candidates = [ T.length b
>                    | scheme <- ["https://", "http://", "gopher://"]
>                    , let (b, a) = T.breakOn scheme t
>                    , not (T.null a)
>                    , maybe True (isSpace . snd) (T.unsnoc b) ]
>   in if T.null t || null candidates then Nothing else
>      let idx               = minimum candidates
>          (before, fromUrl) = T.splitAt idx t
>          (urlRaw, after)   = T.break isSpace fromUrl
>          urlNoTail         = T.dropWhileEnd
>                                (`elem` (".,;:!?" :: String)) urlRaw
>          -- Strip trailing @)@ only if the URL itself contains no @(@,
>          -- so Wikipedia URLs like @Foo_(bar)@ survive a sentence-
>          -- wrapping @(…)@ unchanged.
>          url               = if T.any (== '(') urlNoTail
>                                 then urlNoTail
>                                 else T.dropWhileEnd (== ')') urlNoTail
>          labelRaw          = before <> " " <> after
>          label             = T.unwords (T.words labelRaw)
>      in case (T.stripPrefix "https://" url, T.stripPrefix "http://" url) of
>           (Just r, _) | not (T.null r) -> Just (HttpUrl url label)
>           (_, Just r) | not (T.null r) -> Just (HttpUrl url label)
>           _ -> case parseGopherUrl url of
>                  Just (typeC, h, p, s) -> Just (GopherUrl typeC h p s label)
>                  Nothing               -> Nothing

> -- | Compact label for an image URL row: scheme stripped, trimmed to
> -- @host/<basename>@.
> --
> -- >>> labelOf "https://example.com/path/to/cat.png"
> -- "example.com/cat.png"
> --
> -- >>> labelOf "http://x/y.gif?v=2"
> -- "x/y.gif"
> labelOf :: T.Text -> T.Text
> labelOf url =
>   let noScheme = case T.breakOn "://" url of
>                    (_, rest) | not (T.null rest) -> T.drop 3 rest
>                    _                             -> url
>       noQuery  = T.takeWhile (\c -> c /= '?' && c /= '#') noScheme
>       (host, restPath) = T.break (== '/') noQuery
>       basename = case reverse (T.splitOn "/" restPath) of
>                    (b : _) | not (T.null b) -> b
>                    _                        -> ""
>   in if T.null basename then host else host <> "/" <> basename

> -- | The image extension (with leading dot, lowercased) for an URL we
> -- already accepted via 'classifyUrlLine'. Used to suffix the
> -- base64url-encoded selector so strict gopher clients see the right
> -- file type on the path.
> --
> -- >>> extOf "https://x.com/a.PNG"
> -- ".png"
> --
> -- >>> extOf "https://x.com/a.gif?v=2"
> -- ".gif"
> extOf :: T.Text -> T.Text
> extOf url =
>   let bare = T.takeWhile (\c -> c /= '?' && c /= '#') url
>       low  = T.toLower bare
>   in case filter (`T.isSuffixOf` low)
>                  [".png", ".gif", ".jpg", ".jpeg", ".webp"] of
>        (e : _) -> e
>        []      -> ".png"

> -- | Decode the @/extimg/<…>@ tail back to a URL: strip the trailing
> -- image extension, base64url-decode the rest. If the body isn't a
> -- valid base64url payload, fall through to the raw text (so an
> -- old-format plain-URL link still resolves).
> decodeExtImgPath :: T.Text -> T.Text
> decodeExtImgPath rest =
>   let low      = T.toLower rest
>       stripped = case filter (`T.isSuffixOf` low)
>                              [".png", ".gif", ".jpg", ".jpeg", ".webp"] of
>                    (e : _) -> T.dropEnd (T.length e) rest
>                    []      -> rest
>   in case decodeBase64Url stripped of
>        Just bs -> TE.decodeUtf8With TEE.lenientDecode bs
>        Nothing -> rest

> -- | A tiny valid 1×1 PNG, served by @/img@ when a line can't be
> -- found or decoded — so a client asking for image bytes always gets
> -- image bytes, never a stray gophermap. Decoded from base64 via our
> -- own 'decodeBase64' (which the sandbox test verifies produces a real
> -- PNG); an empty fallback is harmless if that ever failed.
> placeholderPng :: BS.ByteString
> placeholderPng = maybe BS.empty id (decodeBase64 placeholderB64)
>   where
>     placeholderB64 =
>       "iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAQAAAC1HAwCAAAAC0lEQVR42mNk\
>       \+M8AAAMBAQDJ/pLvAAAAAElFTkSuQmCC"

Sanitisation
------------

User-provided bytes (titles, message content) land inside menu rows.
Without scrubbing control bytes, a title with an embedded TAB would
parse as two gophermap fields on the wire.

The LH bits mirror grep.lhs's trust boundary: an abstract predicate
@noRowBreaks@ and an `assume` that 'sanitize' produces text
satisfying it. The body isn't reflected — LH believes us, because the
function is trivially auditable and the doctests below pin its
behaviour. Once the row builders are refined to demand 'SafeText',
LH will reject any caller that forgets to route untrusted text
through 'sanitize' first.

> -- | >>> sanitize "ok"
> -- "ok"
> --
> -- >>> sanitize "with\ttab"
> -- "with tab"
> --
> -- >>> sanitize "line\nbreak"
> -- "line break"
> {-@ measure noRowBreaks :: T.Text -> Bool @-}
> {-@ type SafeText = {t:T.Text | noRowBreaks t} @-}
> {-@ assume sanitize :: T.Text -> SafeText @-}
> sanitize :: T.Text -> T.Text
> sanitize = T.map (\c -> if c == '\r' || c == '\n' || c == '\t' then ' ' else c)

Size rendering
--------------

Sizes surface to the user in whole kilobytes — the index labels every
thread with its size, and the "thread full" messages quote the cap.

> -- | Bytes as whole kilobytes, rounding *up* so any non-empty file
> -- reads as at least @1@; a 0-byte file reads as @0@. Marked
> -- `assume` so LH propagates the non-negative postcondition without
> -- reasoning about integer division (which it can't do precisely);
> -- the doctests are the real check on the arithmetic.
> --
> -- >>> kbOf 0
> -- 0
> --
> -- >>> kbOf 1
> -- 1
> --
> -- >>> kbOf 1024
> -- 1
> --
> -- >>> kbOf 1025
> -- 2
> --
> -- >>> kbOf 5000
> -- 5
> {-@ assume kbOf :: Integer -> {k:Integer | k >= 0} @-}
> kbOf :: Integer -> Integer
> kbOf b = (b + 1023) `div` 1024

> -- | A byte count rendered as a @"N KB"@ label.
> --
> -- >>> sizeLabel 0
> -- "0 KB"
> --
> -- >>> sizeLabel 2048
> -- "2 KB"
> --
> -- >>> sizeLabel 1500
> -- "2 KB"
> sizeLabel :: Integer -> T.Text
> sizeLabel b = T.pack (show (kbOf b)) <> " KB"

> -- | A count with its noun, pluralised by adding @s@ for everything
> -- but 1. Used for the "N lines (M bytes) omitted" preview marker.
> --
> -- >>> plural 1 "line"
> -- "1 line"
> --
> -- >>> plural 0 "byte"
> -- "0 bytes"
> --
> -- >>> plural 3 "line"
> -- "3 lines"
> plural :: Int -> T.Text -> T.Text
> plural 1 w = "1 " <> w
> plural n w = T.pack (show n) <> " " <> w <> "s"

> -- | The UTF-8 byte length of a string — what actually lands on disk,
> -- which `length` (character count) and a Latin-1 pack both get wrong
> -- for multibyte text. Size checks use this so a thread of accented
> -- text is capped by its real on-disk size, not its character count.
> --
> -- >>> utf8Len "abc"
> -- 3
> --
> -- >>> utf8Len "café"
> -- 5
> --
> -- >>> utf8Len ""
> -- 0
> utf8Len :: String -> Int
> utf8Len = BS.length . TE.encodeUtf8 . T.pack

> -- | Collapse a message onto a single line by turning CR and LF into
> -- spaces, so one post is always exactly one line in the log file: a
> -- user can't paste newlines to inject extra log lines, smuggle a fake
> -- separator, or split the title across rows. This is the invariant
> -- that makes gophermap pass-through ('isGophermapRow') safe — a
> -- stored line can never become more than one wire row. TAB is left
> -- alone (it's a gophermap field separator, see 'unescape').
> --
> -- >>> oneLine "hello"
> -- "hello"
> --
> -- >>> oneLine "two\nlines"
> -- "two lines"
> --
> -- >>> oneLine "crlf\r\nhere"
> -- "crlf  here"
> --
> -- >>> oneLine ""
> -- ""
> oneLine :: String -> String
> oneLine = map (\c -> if c == '\r' || c == '\n' then ' ' else c)

> -- | Translate the escapes a user can type in a gopher query into the
> -- bytes they denote. A query can't carry a literal TAB — the protocol
> -- uses TAB to split the selector from the search string — so to post
> -- a gophermap row (which is TAB-delimited) a user writes @\\t@ and we
> -- turn it into a real TAB here. @\\\\@ becomes a single backslash, so
> -- a literal @\\t@ is still writable as @\\\\t@. Processed left to
> -- right; any other backslash run is left verbatim.
> --
> -- Deliberately NO @\\n@/@\\r@ escape: those would let a user inject a
> -- real row break and defeat 'oneLine's one-line-per-post invariant.
> --
> -- >>> unescape "plain text"
> -- "plain text"
> --
> -- >>> unescape "a\\tb"
> -- "a\tb"
> --
> -- >>> unescape "back\\\\slash"
> -- "back\\slash"
> --
> -- >>> unescape "trailing\\"
> -- "trailing\\"
> unescape :: String -> String
> unescape []                = []
> unescape ('\\' : 't'  : r) = '\t' : unescape r
> unescape ('\\' : '\\' : r) = '\\' : unescape r
> unescape (c : r)           = c    : unescape r

> -- | Prepare a submitted message for storage: 'unescape' the @\\t@
> -- escapes into real tabs first, then 'oneLine' to guarantee no row
> -- breaks survive. Order matters only for safety's sake — 'unescape'
> -- never produces CR/LF, and 'oneLine' runs last so any real break is
> -- always stripped.
> --
> -- >>> prepareLine "0Link\\tsel\\thost\\t70"
> -- "0Link\tsel\thost\t70"
> --
> -- >>> prepareLine "two\nlines and a \\t tab"
> -- "two lines and a \t tab"
> prepareLine :: String -> String
> prepareLine = oneLine . unescape

Log filename helpers
--------------------

Threads are named `<id>_<epoch>_<title-slug>.txt`. The id is a short
hex string for collision-resistance; the epoch is POSIX seconds; the
slug is a URI-safe, filesystem-safe rendering of the first line of
the opening message.

> -- | Maximum slug length, in characters. Verified @>= 1@ by LH: a
> -- zero-length cap would slug every title to the empty string and
> -- fall back to "untitled" every time.
> {-@ maxSlugLen :: {v:Int | v >= 1} @-}
> maxSlugLen :: Int
> maxSlugLen = 60

> -- | Turn arbitrary text into a legible, URI-safe, filesystem-safe
> -- slug. The rules, in order:
> --
> --   * ASCII letters are lowercased, ASCII digits kept;
> --   * everything else (punctuation, whitespace, non-ASCII) is
> --     treated as a word break;
> --   * the words are rejoined with single underscores — so no
> --     leading, trailing, or run-of separators can survive;
> --   * the result is capped at 'maxSlugLen' characters, and any
> --     separator the cut left dangling is trimmed.
> --
> -- This is the readable-slug fix: the old version mapped every
> -- non-alphanumeric byte to its own dash, so @"Hello, World!"@ became
> -- @"hello--world-"@. Collapsing word breaks instead gives a clean
> -- @"hello_world"@. Underscore is the separator (both URI-unreserved
> -- and filename-safe); 'splitFilename' rejoins it, so a slug holding
> -- underscores parses back fine despite @_@ also delimiting the
> -- @id_epoch_slug@ filename fields.
> --
> -- >>> slugify "Hello, World!"
> -- "hello_world"
> --
> -- >>> slugify ""
> -- ""
> --
> -- >>> slugify "   leading and trailing   "
> -- "leading_and_trailing"
> --
> -- >>> slugify "Multiple---dashes & symbols!!!"
> -- "multiple_dashes_symbols"
> --
> -- >>> slugify "snake_case_words"
> -- "snake_case_words"
> --
> -- >>> slugify "12 Monkeys"
> -- "12_monkeys"
> --
> -- >>> slugify "Café déjà vu"
> -- "caf_d_j_vu"
> --
> -- >>> length (slugify (replicate 100 'a'))
> -- 60
> slugify :: String -> String
> slugify =
>   dropTrailingSep . take maxSlugLen . intercalate "_" . words . map keepOrSpace
>   where
>     keepOrSpace c
>       | isAsciiLower c = c
>       | isAsciiUpper c = toLower c
>       | isDigit c      = c
>       | otherwise      = ' '
>     dropTrailingSep = reverse . dropWhile (== '_') . reverse

> -- | Parse a log filename @"id_epoch_title.txt"@ into its three
> -- components. The @.txt@ suffix is stripped. @id@ (hex) and @epoch@
> -- (digits) never contain @_@, so the first two @_@-delimited fields
> -- are always exactly those; the remainder is rejoined as the title,
> -- which is what lets 'slugify' use @_@ inside the slug freely.
> --
> -- >>> splitFilename "abc123_1730000000_hello_world.txt"
> -- ("abc123","1730000000","hello_world")
> --
> -- >>> splitFilename "id_epoch_a_b.txt"
> -- ("id","epoch","a_b")
> --
> -- >>> splitFilename "no-underscores.txt"
> -- ("no-underscores","","no-underscores")
> --
> -- >>> splitFilename "a_b.txt"
> -- ("a","b","")
> splitFilename :: FilePath -> (String, String, String)
> splitFilename fn =
>   let base  = if ".txt" `isSuffixOf` fn
>                 then take (length fn - 4) fn
>                 else fn
>       parts = splitOn '_' base
>   in case parts of
>        (a : b : rest) -> (a, b, joinWith '_' rest)
>        _              -> (base, "", base)
>   where
>     splitOn :: Char -> String -> [String]
>     splitOn _ "" = [""]
>     splitOn c s  =
>       let (h, r) = break (== c) s
>       in case r of
>            []         -> [h]
>            (_ : r')   -> h : splitOn c r'
>     joinWith :: Char -> [String] -> String
>     joinWith _ []       = ""
>     joinWith c (x : xs) = x ++ concatMap (c :) xs

ID generation
-------------

The id is the lower 10 hex digits of the current POSIX time in
microseconds. Not cryptographic — collision-resistance is "good
enough for a forum at human pacing", not "an attacker chooses".

`hexEncode` indexes a digit table with `!!`; LH's built-in spec for
`!!` carries an in-range precondition that isn't worth discharging
for a 16-element constant table, so we `ignore` the whole (IO)
function rather than annotate around it.

> {-@ ignore genId @-}
> genId :: IO String
> genId = do
>   t <- getPOSIXTime
>   let n = floor (t * 1000000) :: Integer
>   pure (take 10 (hexEncode n))
>   where
>     hexEncode :: Integer -> String
>     hexEncode 0 = "0"
>     hexEncode x = go x ""
>       where
>         go 0 acc = acc
>         go y acc =
>           let digits = "0123456789abcdef"
>           in go (y `div` 16) (digits !! fromIntegral (y `mod` 16) : acc)

Time + trim
-----------

> fmtTime :: UTCTime -> String
> fmtTime = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC"

> trim :: String -> String
> trim = f . f
>   where f = reverse . dropWhile isSpace

Log file IO
-----------

`listLogs` returns thread files sorted newest-first by mtime.
Filename filter is "ends in .txt AND contains an underscore" — keeps
out stray files an admin might drop into the logs dir.

> listLogs :: IO [(FilePath, UTCTime)]
> listLogs = do
>   exists <- doesDirectoryExist logsDir
>   if not exists
>     then pure []
>     else do
>       files <- listDirectory logsDir
>       let threads = filter (\f -> takeExtension f == ".txt" && '_' `elem` f) files
>       withTimes <- mapM (\f -> do
>                              t <- getModificationTime (logsDir </> f)
>                              pure (f, t))
>                         threads
>       pure (reverse (sortOn snd withTimes))

> -- | What the index shows for one thread's body: the head lines, an
> -- optional @(linesOmitted, bytesOmitted)@ marker, and the tail lines.
> -- A thread of at most @headN + tailN@ lines has no gap — every line
> -- lands in 'previewHead', 'previewTail' is empty, and 'previewOmitted'
> -- is 'Nothing'.
> data Preview = Preview
>   { previewHead    :: [(Int, BS.ByteString)]
>   , previewOmitted :: Maybe (Int, Int)
>   , previewTail    :: [(Int, BS.ByteString)]
>   } deriving (Eq, Show)

> -- | Split file bytes into a head/tail preview by *whole lines*, so a
> -- post is never cut mid-line. Past @headN + tailN@ lines, the middle
> -- lines are dropped and reported: @linesOmitted@ is their count,
> -- @bytesOmitted@ their exact byte footprint — each omitted line's
> -- content plus the newline that terminates it. (That's exact because
> -- the final line is always kept in the tail, so every omitted line is
> -- followed by a newline in the file.) At or below @headN + tailN@
> -- lines there's no gap and every line is in 'previewHead'.
> --
> -- >>> makePreview 1 1 "aaa\nbbb\nccc\nddd\neee"
> -- Preview {previewHead = [(0,"aaa")], previewOmitted = Just (3,12), previewTail = [(4,"eee")]}
> --
> -- >>> makePreview 2 2 "a\nb\nc"
> -- Preview {previewHead = [(0,"a"),(1,"b"),(2,"c")], previewOmitted = Nothing, previewTail = []}
> --
> -- >>> makePreview 1 1 ""
> -- Preview {previewHead = [], previewOmitted = Nothing, previewTail = []}
> --
> -- >>> makePreview 1 1 "x\ny\nz\n"
> -- Preview {previewHead = [(0,"x")], previewOmitted = Just (1,2), previewTail = [(2,"z")]}
> makePreview :: Int -> Int -> BS.ByteString -> Preview
> makePreview headN tailN bs
>   | n <= headN + tailN = Preview indexed Nothing []
>   | otherwise          = Preview (take headN indexed)
>                                  (Just (omLines, omBytes))
>                                  (drop (n - tailN) indexed)
>   where
>     ls      = BSC.lines bs
>     indexed = zip [0 ..] ls
>     n       = length ls
>     omLines = n - headN - tailN
>     omitted = take omLines (drop headN ls)
>     omBytes = sum (map ((+ 1) . BS.length) omitted)

> -- | 'makePreview' for a file on disk, reading it whole ('Preview' of
> -- empties for a missing file). Reading the whole file matches the old
> -- preview path; the per-thread 'maxLogSizeKb' cap bounds how much
> -- that ever is.
> readPreview :: FilePath -> IO Preview
> readPreview fp = do
>   exists <- doesFileExist fp
>   if not exists
>     then pure (Preview [] Nothing [])
>     else makePreview previewHeadLines previewTailLines <$> BS.readFile fp

Pruning
-------

`pruneOldLogs` enforces the 'maxLogs' ceiling: it deletes the oldest
threads (by mtime) until at most 'maxLogs' remain, and returns the
filenames it removed so the create handler can report them. Called
after a successful create, so the board behaves as a ring buffer —
posting a new thread bumps off the oldest once the cap is reached.

> pruneOldLogs :: IO [FilePath]
> pruneOldLogs = do
>   logs <- listLogs                       -- newest-first
>   let victims = map fst (drop maxLogs logs)
>   mapM_ (\f -> removeFile (logsDir </> f)) victims
>   pure victims

Duplicate-content guards
------------------------

`firstLineOf` and `lastLineOf` extract the trimmed first / last lines
of a file's bytes for the dedupe checks below. Both decode via
`lenientDecode` so a stray non-UTF-8 byte doesn't crash the read;
both apply `T.strip` so the comparison is whitespace-insensitive.

Examples cover the empty-file, no-newline, with-newline, and
trailing-newline shapes — the four real edge cases for a forum log.

> -- | >>> firstLineOf "first\nsecond\nthird"
> -- "first"
> --
> -- >>> firstLineOf ""
> -- ""
> --
> -- >>> firstLineOf "no-newline"
> -- "no-newline"
> --
> -- >>> firstLineOf "  with-leading-space\nfoo"
> -- "with-leading-space"
> firstLineOf :: BS.ByteString -> T.Text
> firstLineOf bs =
>   T.strip (TE.decodeUtf8With TEE.lenientDecode (BSC.takeWhile (/= '\n') bs))

> -- | >>> lastLineOf "first\nsecond\nthird"
> -- "third"
> --
> -- >>> lastLineOf "only"
> -- "only"
> --
> -- >>> lastLineOf ""
> -- ""
> --
> -- >>> lastLineOf "trailing\n"
> -- "trailing"
> --
> -- >>> lastLineOf "first\nsecond  "
> -- "second"
> lastLineOf :: BS.ByteString -> T.Text
> lastLineOf bs = case reverse (BSC.lines bs) of
>   []      -> T.empty
>   (l : _) -> T.strip (TE.decodeUtf8With TEE.lenientDecode l)

'CreateError' carries enough context for the response page to be
useful: in particular, the 'CreateDuplicateOpening' variant holds
the filename of the existing thread, so the rendered error can link
straight to it.

> data CreateError
>   = CreateMessageTooLarge          -- submission > maxSubmissionBytes
>   | CreateIdCollision              -- ultra-rare same-microsecond reuse
>   | CreateDuplicateOpening FilePath -- carries the existing log's filename
>   deriving Show

> createErrorMessage :: CreateError -> T.Text
> createErrorMessage err = case err of
>   CreateMessageTooLarge    -> "your submission was too long (max "
>                               <> T.pack (show maxSubmissionKb) <> " KB)"
>   CreateIdCollision        -> "id collision (try again)"
>   CreateDuplicateOpening _ -> "an existing log already opens with this exact line"

> createNewLog :: String -> IO (Either CreateError FilePath)
> createNewLog rawMessage =
>   let message = prepareLine rawMessage in    -- one post == one line on disk
>   if utf8Len message > maxSubmissionBytes
>     then pure (Left CreateMessageTooLarge)
>     else do
>       now <- getPOSIXTime
>       let epoch        = floor now :: Integer
>           titleLine    = message
>           -- Slug from the gophermap label when the opener is a menu
>           -- line, else from the line itself (see 'titleSource').
>           slugBasis    = T.unpack (titleSource (T.pack titleLine))
>           slugged      = slugify (trim slugBasis)
>           safeSlug     = if null slugged then "untitled" else slugged
>           candidateTxt = T.strip (T.pack titleLine)
>       -- Reject + name the offending thread when the opening line
>       -- matches an existing thread. The matching filename is carried
>       -- through to the response so we can link directly to it.
>       mDup <- findOpeningLineMatch candidateTxt
>       case mDup of
>         Just existingFname -> pure (Left (CreateDuplicateOpening existingFname))
>         Nothing -> do
>           lid <- genId
>           let fname = lid ++ "_" ++ show epoch ++ "_" ++ safeSlug ++ ".txt"
>               path  = logsDir </> fname
>           collides <- doesFileExist path
>           if collides
>             then pure (Left CreateIdCollision)
>             else do
>               withFile path WriteMode $ \h -> do
>                 hSetEncoding h utf8
>                 hPutStr h message
>               pure (Right fname)

> -- | Return 'Just' the existing thread's filename when its first line
> -- (trimmed) matches the candidate (trimmed); 'Nothing' otherwise.
> -- Short-circuits on the first hit so we don't read every log file
> -- in directories with many threads.
> findOpeningLineMatch :: T.Text -> IO (Maybe FilePath)
> findOpeningLineMatch candidate = do
>   exists <- doesDirectoryExist logsDir
>   if not exists
>     then pure Nothing
>     else do
>       files <- listDirectory logsDir
>       let threads = filter (\f -> takeExtension f == ".txt" && '_' `elem` f) files
>           go [] = pure Nothing
>           go (f : rest) = do
>             let p = logsDir </> f
>             ok <- doesFileExist p
>             if not ok
>               then go rest
>               else do
>                 bs <- BS.readFile p
>                 if firstLineOf bs == candidate
>                   then pure (Just f)
>                   else go rest
>       go threads

Appending is where 'maxLogSizeKb' bites: a thread that has already
reached the cap is *closed* — no reply is accepted, regardless of how
small it is. A reply that would push a still-open thread past the cap
is likewise rejected, so the on-disk size never exceeds the ceiling.

> -- | Resolve a thread by its id to its filename. Reuses the
> -- @<id>_@-prefix + @.txt@ convention; the id only *selects* among
> -- existing files (no path is ever built from it), so a crafted id
> -- can't escape 'logsDir'. Shared by 'appendToLog', 'emitThread', and
> -- 'emitImage' so they all agree on which file an id names.
> findLogById :: String -> IO (Maybe FilePath)
> findLogById lid = do
>   exists <- doesDirectoryExist logsDir
>   if not exists
>     then pure Nothing
>     else do
>       files <- listDirectory logsDir
>       let candidates = filter (\f -> (lid ++ "_") `isPrefixOf` f
>                                      && takeExtension f == ".txt")
>                               files
>       pure (case candidates of (fn : _) -> Just fn; [] -> Nothing)

> appendToLog :: String -> String -> IO (Either String FilePath)
> appendToLog lid rawMessage = do
>   let message = prepareLine rawMessage      -- one post == one line on disk
>       tmsg    = T.pack message
>   if utf8Len message > maxSubmissionBytes
>     then pure (Left ("your line was too long (max "
>                      ++ show maxSubmissionKb ++ " KB)"))
>     -- An @img:@ submission that doesn't decode to a *complete* image
>     -- is almost always one Venusia chopped at its request-buffer limit
>     -- (8192 bytes on this host). Reject it with a clear message instead
>     -- of storing a broken line that would silently render as text.
>     else if imgPrefix `T.isPrefixOf` tmsg && classifyImageLine tmsg == Nothing
>       then pure (Left "image didn't decode (or was truncated — keep it \
>                        \under ~6 KB including the selector)")
>       else do
>         mFile <- findLogById lid
>         case mFile of
>           Nothing -> pure (Left "no matching log id")
>           Just fn -> do
>             let path     = logsDir </> fn
>                 sepMsg   = '\n' : message    -- newline separator before the new line
>                 addBytes = utf8Len sepMsg
>             size0 <- getFileSize path
>             if fromIntegral size0 >= maxLogSizeBytes
>               then pure (Left ("log is full (" ++ show maxLogSizeKb
>                                ++ " KB cap reached); it is closed to replies"))
>               else do
>                 -- Reject a reply whose content equals the log's current
>                 -- last line. The comparison uses trimmed Text so trailing
>                 -- whitespace, stray carriage returns, or the missing-newline-
>                 -- vs-with-newline distinction don't false-negative.
>                 existing <- BS.readFile path
>                 let prevLine = lastLineOf existing
>                     newLine  = T.strip tmsg
>                 if prevLine == newLine
>                   then pure (Left "new line is identical to the previous line")
>                   else if fromIntegral size0 + addBytes > maxLogSizeBytes
>                     then pure (Left ("reply would exceed the " ++ show maxLogSizeKb
>                                      ++ " KB per-log cap"))
>                     else do
>                       withFile path AppendMode $ \h -> do
>                         hSetEncoding h utf8
>                         hPutStr h sepMsg
>                       pure (Right fn)

Self-link helpers
-----------------

`logsSel` is the file-server selector that lists the `logs/` sibling
directory. `link` builds a path-info'd self-selector under this
script's mount point. Both derive from `ctxScriptSel` so renaming
the .lhs or moving its `[[files]]` block keeps everything pointing
the right way.

> link :: Ctx -> T.Text -> T.Text
> link ctx sub = ctxScriptSel ctx <> "/" <> sub

> logsSel :: Ctx -> T.Text
> logsSel ctx = T.dropWhileEnd (/= '/') (ctxScriptSel ctx) <> "logs"

> homeMenu :: Ctx -> T.Text
> homeMenu ctx =
>   menuLine "← back to interlog" (ctxScriptSel ctx) (ctxHost ctx) (ctxPort ctx)

Index page
----------

Header (with the active caps) + raw-logs link + "new" search prompt,
then one block per thread, newest first. Each block: a link labelled
with the thread's title, timestamp, and size in KB; the thread's
content (shown whole if short, otherwise head + an "N lines (M bytes)
omitted" marker + tail); and an "append" search prompt — unless the
thread has hit 'maxLogSizeKb', in which case a "closed to replies"
notice replaces the prompt. Any preview line that is itself a valid
gophermap row renders as a real menu row (see 'renderContentLine').

> emitIndex :: Ctx -> IO ()
> emitIndex ctx = do
>   logs <- listLogs
>   mapM_ putLine $
>     [ infoLine "interlog — interactive logs"
>     , infoLine "Append-only logs. Plain text. No DB, no daemon."
>     , infoLine ("Up to " <> T.pack (show maxLogs)
>                 <> " logs (oldest pruned); "
>                 <> T.pack (show maxLogSizeKb) <> " KB each.")
>     , menuLine "Browse raw logs directory" (logsSel ctx)
>              (ctxHost ctx) (ctxPort ctx)
>     , searchLine "Create new log" (link ctx "new")
>                  (ctxHost ctx) (ctxPort ctx)
>     , menuLine "FAQ — questions I'm not sure I've been asked but I think are useful to know"
>                (link ctx "faq") (ctxHost ctx) (ctxPort ctx)
>     , infoLine ""
>     ]
>   mapM_ (renderEntry ctx) (take maxLogs logs)
>   putLine terminator

> renderEntry :: Ctx -> (FilePath, UTCTime) -> IO ()
> renderEntry ctx (fn, mt) = do
>   let (lid, _, title) = splitFilename fn
>       display         = if null title then fn else title
>       path            = logsDir </> fn
>       viewSel         = link ctx ("view/" <> T.pack lid)
>       appendSel       = link ctx ("append/" <> T.pack lid)
>       rawSel          = logsSel ctx <> "/" <> T.pack fn
>   pv   <- readPreview path
>   size <- getFileSize path
>   -- The link itself is exactly: title, timestamp, size in KB.
>   let label = T.pack display
>               <> "  [" <> T.pack (fmtTime mt) <> "]"
>               <> "  (" <> sizeLabel size <> ")"
>   putLine (menuLine label viewSel (ctxHost ctx) (ctxPort ctx))
>   -- Beneath the link, the thread's content: shown whole when short,
>   -- otherwise head + a marker naming how much was skipped + tail. Each
>   -- line renders through 'renderThreadLine' with its real file index,
>   -- so an inline image is a working image row right here on the index.
>   let renderPair (i, raw) = renderThreadLine ctx (T.pack lid) i raw
>   if null (previewHead pv) && null (previewTail pv)
>     then putLine (infoLine "(empty)")
>     else do
>       mapM_ (putLine . renderPair) (previewHead pv)
>       case previewOmitted pv of
>         Just (omLines, omBytes) -> do
>           putLine (infoLine ("--- " <> plural omLines "line"
>                              <> " (" <> plural omBytes "byte" <> ") omitted ---"))
>           mapM_ (putLine . renderPair) (previewTail pv)
>         Nothing -> pure ()
>   putLine (textLine "View raw" rawSel (ctxHost ctx) (ctxPort ctx))
>   if size >= fromIntegral maxLogSizeBytes
>     then putLine (infoLine ("(full — reached the "
>                             <> T.pack (show maxLogSizeKb)
>                             <> " KB cap; closed to replies)"))
>     else putLine (searchLine "Append line" appendSel
>                              (ctxHost ctx) (ctxPort ctx))
>   putLine (infoLine "")

Whole-thread view
-----------------

'emitThread' renders a whole thread as a gophermap. Its per-line
renderer, 'renderThreadLine', is shared with the index preview
('renderEntry'), so inline images ('img:' lines) become real image
rows in both places. Lines keep their file-order index (matching
'BSC.lines'), and that index is exactly what 'emitImage' re-reads, so
an image row's @/img/<id>/<n>@ link always names the same line.

> -- | Render one stored line for a menu (thread view or index preview):
> -- a gophermap row passes through; an @img:@ inline image becomes an
> -- image row linking to @/img/<id>/<n>@; anything else is a sanitised
> -- info line.
> renderThreadLine :: Ctx -> T.Text -> Int -> BS.ByteString -> T.Text
> renderThreadLine ctx lid n raw =
>   let line = TE.decodeUtf8With TEE.lenientDecode raw
>   in if isGophermapRow line
>        then line
>        else case classifyImageLine line of
>               Just (_, bytes) ->
>                 imageLine ("image (" <> T.pack (show (BS.length bytes)) <> " bytes)")
>                           (link ctx ("img/" <> lid <> "/" <> T.pack (show n)))
>                           (ctxHost ctx) (ctxPort ctx)
>               Nothing -> case classifyUrlLine line of
>                 Just (HttpUrl url label)
>                   | hasImageExt url ->
>                       let lbl = if T.null label
>                                   then "image: " <> labelOf url
>                                   else label <> " (" <> hostOfUrl url <> ")"
>                           encUrl = encodeBase64Url (TE.encodeUtf8 url)
>                                    <> extOf url
>                       in imageLine lbl (link ctx ("extimg/" <> encUrl))
>                                    (ctxHost ctx) (ctxPort ctx)
>                   | otherwise ->
>                       let lbl = if T.null label
>                                   then labelOf url
>                                   else label <> " (" <> hostOfUrl url <> ")"
>                       in urlLine lbl url (ctxHost ctx) (ctxPort ctx)
>                 Just (GopherUrl typeC h p sel label) ->
>                   let lbl = if T.null label
>                               then h <> sel
>                               else label <> " (" <> h <> ")"
>                   in typedLine typeC lbl sel h p
>                 Nothing -> infoLine line

> emitThread :: Ctx -> T.Text -> IO ()
> emitThread ctx lid = do
>   mFile <- findLogById (T.unpack lid)
>   case mFile of
>     Nothing -> emitFailure ctx ("no log with id " <> lid)
>     Just fn -> do
>       let (_, _, title) = splitFilename fn
>           display       = if null title then fn else title
>           path          = logsDir </> fn
>           rawSel        = logsSel ctx <> "/" <> T.pack fn
>       bs   <- BS.readFile path
>       size <- getFileSize path
>       let bodyRows = zipWith (renderThreadLine ctx lid) [0 ..] (BSC.lines bs)
>           foot     = if size >= fromIntegral maxLogSizeBytes
>                        then [ infoLine ("(full — reached the "
>                                         <> T.pack (show maxLogSizeKb)
>                                         <> " KB cap; closed to replies)") ]
>                        else [ searchLine "Append line" (link ctx ("append/" <> lid))
>                                          (ctxHost ctx) (ctxPort ctx) ]
>       mapM_ putLine $
>         [ infoLine ("interlog — " <> T.pack display)
>         , infoLine ("[" <> sizeLabel size <> "]")
>         , infoLine ""
>         ] ++ bodyRows ++ [ infoLine "" ] ++ foot ++
>         [ textLine "View raw" rawSel (ctxHost ctx) (ctxPort ctx)
>         , homeMenu ctx
>         , terminator
>         ]

The @/img/<id>/<n>@ endpoint
----------------------------

Serves the raw bytes of the @n@-th line of thread @<id>@ when that
line is a complete inline image, re-validating magic + trailer before
writing. It emits NO gophermap and NO terminator — the response *is*
the image. Any miss (bad index, missing log, line that no longer
decodes) serves 'placeholderPng', so a client that requested image
bytes never receives a stray menu. @n@ only indexes an in-memory line
list and @<id>@ only selects an existing file, so neither can touch
the filesystem directly.

> {-@ ignore emitImage @-}
> emitImage :: Ctx -> T.Text -> T.Text -> IO ()
> emitImage _ctx lid nTxt = do
>   served <- case readMaybe (T.unpack nTxt) :: Maybe Int of
>     Just n | n >= 0 -> do
>       mFile <- findLogById (T.unpack lid)
>       case mFile of
>         Nothing -> pure False
>         Just fn -> do
>           bs <- BS.readFile (logsDir </> fn)
>           case drop n (BSC.lines bs) of
>             (l : _) ->
>               case classifyImageLine (TE.decodeUtf8With TEE.lenientDecode l) of
>                 Just (_, bytes) -> BS.hPut stdout bytes >> pure True
>                 Nothing         -> pure False
>             [] -> pure False
>     _ -> pure False
>   if served then pure () else BS.hPut stdout placeholderPng

The @/extimg/<url>@ endpoint
----------------------------

Streaming proxy for HTTP(S) image URLs posted as bare lines (see
'classifyUrlLine'). Bytes flow from the remote response straight to
stdout via 'H.brRead' + 'BS.hPut' — nothing is written to disk and
nothing is buffered beyond the per-chunk 'BS.ByteString' the writer
consumes immediately. A pre-flight DNS check ('isPublicHost') blocks
SSRF against private/loopback IPs before any socket opens. Hard
caps (timeout, redirects, byte total) guard unbounded use. Any
failure → 'placeholderPng', so a client that asked for image bytes
always receives image bytes, never a stray menu.

> maxStreamBytes :: Int
> maxStreamBytes = 5 * 1024 * 1024     -- 5 MB safety cap (aborted, not buffered)

> -- | Wall-clock cap on a single @/extimg@ request, in seconds. Bounds
> -- *time*, not bytes — without this a slow-drip remote (one byte every
> -- N seconds) would never trip the byte cap and could hold our socket
> -- and thread open indefinitely. Fires via 'System.Timeout.timeout',
> -- which throws an async exception that 'H.withResponse' cleans up.
> maxStreamSeconds :: Int
> maxStreamSeconds = 60

> -- | Max gap between bytes received from the remote, in microseconds
> -- (http-client's 'responseTimeout'). A trickle-attack remote that
> -- pauses longer than this gets cut. Tighter than the wall-clock cap
> -- so an idle connection dies fast instead of waiting out the minute.
> extimgInterByteMicros :: Int
> extimgInterByteMicros = 10 * 1000 * 1000     -- 10 s

> -- | Extract the host (sans port) from an HTTP(S) URL for the DNS
> -- pre-flight check.
> --
> -- >>> hostOfUrl "https://example.com:8080/x.png"
> -- "example.com"
> --
> -- >>> hostOfUrl "http://x/y.gif"
> -- "x"
> hostOfUrl :: T.Text -> T.Text
> hostOfUrl url =
>   let noScheme = case T.breakOn "://" url of
>                    (_, rest) | not (T.null rest) -> T.drop 3 rest
>                    _                             -> url
>       (hostport, _) = T.break (== '/') noScheme
>       (host,     _) = T.break (== ':') hostport
>   in host

> -- | True for IPv4/IPv6 addresses outside the standard private,
> -- loopback, link-local and unique-local ranges.
> isPublicSockAddr :: SockAddr -> Bool
> isPublicSockAddr (SockAddrInet _ ip) =
>   let (a, b, _, _) = hostAddressToTuple ip
>   in not ( a == 0
>         || a == 10
>         || a == 127
>         || (a == 169 && b == 254)
>         || (a == 172 && b >= 16 && b < 32)
>         || (a == 192 && b == 168) )
> isPublicSockAddr (SockAddrInet6 _ _ ip _) =
>   let t = hostAddress6ToTuple ip
>       (a, _, _, _, _, _, _, _) = t
>   in t /= ((0,0,0,0,0,0,0,0) :: (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16))
>      && t /= (0,0,0,0,0,0,0,1)
>      && not (a >= 0xfe80 && a <= 0xfebf)
>      && not (a >= 0xfc00 && a <= 0xfdff)
> isPublicSockAddr _ = False

> -- | Resolve a host and require every result to be a public IP.
> -- Resolution failure → 'False' (treat as private).
> {-@ ignore isPublicHost @-}
> isPublicHost :: T.Text -> IO Bool
> isPublicHost host = do
>   r <- try (getAddrInfo Nothing (Just (T.unpack host)) Nothing)
>          :: IO (Either SomeException [AddrInfo])
>   case r of
>     Left _    -> pure False
>     Right ais -> pure (not (null ais) && all (isPublicSockAddr . addrAddress) ais)

> -- | Stream the remote HTTP(S) image at @url@ to stdout, with all the
> -- guards above. Never buffers to disk; aborts mid-stream at the byte
> -- cap; falls back to 'placeholderPng' on any failure.
> {-@ ignore emitExtImg @-}
> emitExtImg :: Ctx -> T.Text -> IO ()
> emitExtImg _ctx urlText = do
>   streamedRef <- newIORef False
>   result <- timeout (maxStreamSeconds * 1000 * 1000) $
>     case classifyUrlLine urlText of
>       Just (HttpUrl url _) | hasImageExt url -> do
>         hostOk <- isPublicHost (hostOfUrl url)
>         if hostOk then runStream streamedRef url else pure False
>       _ -> pure False
>   case result of
>     Just True -> pure ()
>     _ -> do
>       -- If we already wrote bytes before the timeout / failure fired,
>       -- the client is receiving a truncated image; appending the
>       -- placeholder would just garble it. Only fall back when nothing
>       -- has been emitted yet.
>       started <- readIORef streamedRef
>       if started then pure () else BS.hPut stdout placeholderPng
>   where
>     runStream ref url = do
>       r <- try (do
>                  mgr <- HTLS.newTlsManager
>                  req <- H.parseRequest (T.unpack url)
>                  let req' = req
>                        { H.responseTimeout = H.responseTimeoutMicro extimgInterByteMicros
>                        , H.redirectCount   = 3
>                        , H.requestHeaders  = [("User-Agent", "interlog-extimg/1.0")]
>                        }
>                  H.withResponse req' mgr (serve ref)) :: IO (Either SomeException Bool)
>       pure (either (const False) id r)
>     serve ref resp = do
>       let s  = statusCode (H.responseStatus resp)
>           ct = lookup hContentType (H.responseHeaders resp)
>           cl = lookup hContentLength (H.responseHeaders resp)
>           okStatus = s == 200
>           okType   = maybe False (BS.isPrefixOf "image/") ct
>           okLen    = maybe True
>                        (\v -> case BSC.readInt v of
>                                 Just (n, _) -> n <= maxStreamBytes
>                                 Nothing     -> True) cl
>       if not (okStatus && okType && okLen) then pure False
>       else do streamLoop ref (H.responseBody resp) 0
>               pure True
>     streamLoop ref reader sent = do
>       chunk <- H.brRead reader
>       if BS.null chunk
>         then pure ()
>         else do
>           let len       = BS.length chunk
>               remaining = maxStreamBytes - sent
>           if remaining <= 0
>             then pure ()
>             else if len <= remaining
>                    then do writeIORef ref True
>                            BS.hPut stdout chunk
>                            streamLoop ref reader (sent + len)
>                    else do writeIORef ref True
>                            BS.hPut stdout (BS.take remaining chunk)

The @/faq@ route
----------------

A cheeky FAQ — hardcoded Q/A pairs rendered as info lines, linked
from the index header so visitors find it without hunting.

> faqEntries :: [(T.Text, T.Text)]
> faqEntries =
>   [ ( "How do I post an inline image?"
>     , "Run  base64 -w0 pic.png  (macOS: base64 -i pic.png) and put the output after  img:  on one line. GUI clients (Lagrange, Dillo) truncate big requests, so the reliable way is straight from the shell:  printf '/applets/interlog/interlog.lhs/append/ID\\timg:%s\\r\\n' \"$(base64 -w0 pic.png)\" | nc gopher.someodd.zip 70  — swap /append/ID for /new to start a thread. The whole post must fit ~8 KB, so keep the image under ~6 KB; PNG and GIF pack best at that size, and the create/append prompt shows your exact budget. Bigger than that? Paste an http(s) image URL on its own line instead.")
>   , ( "Can I post a raw gopher menu row?"
>     , "Yes. A line that is itself a complete 4-field gophermap row — <type><display>\\t<selector>\\t<host>\\t<port> — passes through as a real menu item. A gopher query can't carry a literal TAB, so write \\t (backslash-t) in your post and it becomes a real TAB on the way in. Example: IA nice image.\\t/uploads/stella_maris.jpg\\tgopher.someodd.zip\\t70  renders as a clickable image item. The item-type chars: 0 text, 1 menu, 7 search, I image, h URL link.")
>   , ( "Can I link out to other stuff?"
>     , "Yes — paste any URL, alone or in a sentence (the surrounding text becomes the label, with the domain in parens). HTTP(S) image URLs (.png/.gif/.jpg/.jpeg/.webp) stream through this server as inline image rows; other HTTP(S) URLs become web-link rows (h URL: items). Gopher URLs become a menu row of whatever type the URI declares — gopher://host/Icat.png is an image, gopher://host/0notes.txt is text, and so on.")
>   , ( "Why does my post get rejected?"
>     , "Almost always truncation by your client, not this server. The server reads up to 8192 bytes, but GUI gopher clients chop the request short — Lagrange caps the query at ~1 KB (it inherits Gemini's request-line limit), and Dillo and others have their own small caps. Neither gopher RFC actually requires that: RFC 1436 only suggests selectors stay under 255 chars, and the URI RFC (4266) sets no limit at all — it's a client convention, not gopher's. So a big img: post arrives cut off, fails the completeness check, and is rejected rather than stored broken. Post images from the shell instead (see 'How do I post an inline image?').")
>   , ( "What about animated GIFs?"
>     , "For inline posting (img:base64), yes — the completeness check accepts a complete GIF (trailer 0x3B), but most animated GIFs are well past the ~6 KB cap. For anything bigger, paste a URL on its own line instead: HTTP(S) image URLs stream through, gopher://host/Igif… links cross-server.")
>   , ( "Where do my posts live?"
>     , "Plain text files under /applets/interlog/logs/, one per thread. The board keeps the 64 newest threads (oldest pruned), and each thread caps at 1024 KB.")
>   , ( "Can I delete or edit a post?"
>     , "No. One post is one immutable line; one thread is append-only. The ring buffer eventually evicts old threads though, so if you can wait long enough …")
>   , ( "What's gopher?"
>     , "RFC 1436, 1993. Hypertext, pre-web, menus over a flat protocol with one-character item types — text (0), menu (1), search (7), image (I), and so on. No JavaScript, and that's the point.")
>   , ( "Who runs this?"
>     , "someodd.zip — a personal gopher server. Code at github.com/someodd; interlog is one of several .lhs applets under /applets/.")
>   ]

> emitFaq :: Ctx -> IO ()
> emitFaq ctx = mapM_ putLine $
>   [ infoLine "FAQ — questions I'm not sure I've been asked but I think are useful to know."
>   , infoLine ""
>   ] ++ concatMap renderQA faqEntries ++
>   [ homeMenu ctx
>   , terminator
>   ]
>   where
>     renderQA (q, a) =
>       [ infoLine ("Q. " <> q)
>       , infoLine ("A. " <> a)
>       , infoLine ""
>       ]

New/append prompts
------------------

Reached when the user lands on a `new` or `append/<id>` selector with
no search text yet (rare — most clients prompt for input before
sending). Re-offer the search item rather than render nothing.

> emitNewPrompt :: Ctx -> IO ()
> emitNewPrompt ctx =
>   let nSel = link ctx "new"
>   in mapM_ putLine $
>     [ infoLine "Create a new log — type your opening message."
>     , infoLine "The first line becomes the log title (slugified)."
>     , infoLine "Allows gopher menu lines; \\t gets turned into literal tabs."
>     , infoLine "<item type character><display string>\\t<selector>\\t<host/domain>\\t<port>"
>     , infoLine "e.g.  IA nice image.\\t/uploads/stella_maris.jpg\\tgopher.someodd.zip\\t70"
>     ] ++ budgetLines nSel ++
>     [ infoLine ""
>     , searchLine "Type opening message" nSel (ctxHost ctx) (ctxPort ctx)
>     , homeMenu ctx
>     , terminator
>     ]

> emitAppendPrompt :: Ctx -> T.Text -> IO ()
> emitAppendPrompt ctx lid =
>   let aSel = link ctx ("append/" <> lid)
>   in mapM_ putLine $
>     [ infoLine ("Append a line to log " <> lid <> " — type your reply.")
>     , infoLine "Allows gopher menu lines; \\t gets turned into literal tabs."
>     , infoLine "<item type character><display string>\\t<selector>\\t<host/domain>\\t<port>"
>     , infoLine "e.g.  IA nice image.\\t/uploads/stella_maris.jpg\\tgopher.someodd.zip\\t70"
>     ] ++ budgetLines aSel ++
>     [ infoLine ""
>     , searchLine "Type reply" aSel (ctxHost ctx) (ctxPort ctx)
>     , homeMenu ctx
>     , terminator
>     ]

> emitPathError :: Ctx -> T.Text -> IO ()
> emitPathError ctx pinfo = mapM_ putLine
>   [ errorItem ("Unrecognised path-info: " <> pinfo)
>   , homeMenu ctx
>   , terminator
>   ]

Handle create / append
----------------------

Validate, attempt the IO, render a typed confirmation (or a typed
error) plus a link straight to the just-written log and a home link.
A successful create then prunes the board down to 'maxLogs' and
reports how many old threads that bumped off.

> handleNew :: Ctx -> T.Text -> IO ()
> handleNew ctx msg = do
>   result <- createNewLog (T.unpack msg)
>   case result of
>     Left err     -> emitCreateError ctx err
>     Right fname  -> do
>       pruned <- pruneOldLogs
>       let note = if null pruned
>                    then []
>                    else [ infoLine ("Pruned " <> T.pack (show (length pruned))
>                                     <> " old log(s) to stay within the "
>                                     <> T.pack (show maxLogs) <> "-log cap.") ]
>       emitSuccess ctx fname "Created log" note

> handleAppend :: Ctx -> T.Text -> T.Text -> IO ()
> handleAppend ctx lid msg = do
>   result <- appendToLog (T.unpack lid) (T.unpack msg)
>   case result of
>     Left err     -> emitFailure ctx ("append failed: " <> T.pack err)
>     Right fname  -> emitSuccess ctx fname "Appended to log" []

> -- | Render a 'CreateError'. The 'CreateDuplicateOpening' variant
> -- also emits a type-0 link to the existing thread so the user can
> -- read what was already there instead of being told "no" with no
> -- way forward.
> emitCreateError :: Ctx -> CreateError -> IO ()
> emitCreateError ctx err = mapM_ putLine $
>   [ errorItem ("create failed: " <> createErrorMessage err)
>   , infoLine ""
>   ] ++ refRow ++
>   [ homeMenu ctx
>   , terminator
>   ]
>   where
>     refRow = case err of
>       CreateDuplicateOpening fn ->
>         let (lid, _, title) = splitFilename fn
>             display         = if null title then fn else title
>         in [ menuLine ("View existing log: " <> T.pack display)
>                       (link ctx ("view/" <> T.pack lid))
>                       (ctxHost ctx) (ctxPort ctx)
>            ]
>       _ -> []

> emitSuccess :: Ctx -> FilePath -> T.Text -> [T.Text] -> IO ()
> emitSuccess ctx fname action extra =
>   let (lid, _, _) = splitFilename fname
>   in mapM_ putLine $
>     [ infoLine (action <> ": " <> T.pack fname)
>     , infoLine "(Don't refresh — that would re-submit. Use a link below.)"
>     , infoLine ""
>     ] ++ extra ++
>     [ menuLine ("View " <> T.pack fname)
>                (link ctx ("view/" <> T.pack lid))
>                (ctxHost ctx) (ctxPort ctx)
>     , homeMenu ctx
>     , terminator
>     ]

> emitFailure :: Ctx -> T.Text -> IO ()
> emitFailure ctx msg = mapM_ putLine
>   [ errorItem msg
>   , homeMenu ctx
>   , terminator
>   ]