feat(users/Profpatsch/whatcd-resolver): implement artist refresh v0

This is kind of a chonker because I went into so many rabbit holes.

Foremost this implements a simple “Refresh Artist” button that fetches
current artist torrent groups.

BUG: the `artist` endpoint torrent struct is shite, it’s missing most
info that we get in the `search` endpoint torrent struct, plus it’s
organized differently (e.g. the `artists` thingy is in the
torrent_group not the torrent).

I should switch everything over to fetching the `torrent_group.id`s
first and then going through and slowly fetching every torrent group
separately … however that might time out very quickly. ugh. There
doesn’t seem to be a way of fetching multiple torrent groups.

Random other shit & improvements:

* intersperse for builders
* fix json errors so that the structs don’t get too
  big (`restrictJson`)
* show error messages as json so jaeger displays it with nested UI
* color pretty-printed json outpt on command line
* add some important integral functions to MyPrelude
* add `sintersperse` and `mintersperse` to MyPrelude

Change-Id: If8bfcd68dc5c905e118ad86d50d7416962bf55d4
Reviewed-on: https://cl.tvl.fyi/c/depot/+/12960
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>

users/Profpatsch/whatcd-resolver/src/AppT.hs

@@ -51,6 +51,7 @@ newtype AppT m a = AppT {unAppT :: ReaderT Context m a}
 data AppException
   = AppExceptionTree ErrorTree
   | AppExceptionPretty [Pretty.Err]
+  | AppExceptionEnc Enc
   deriving anyclass (Exception)
 
 instance IsString AppException where
@@ -59,6 +60,7 @@ instance IsString AppException where
 instance Show AppException where
   showsPrec _ (AppExceptionTree t) = ("AppException: " ++) . ((textToString $ prettyErrorTree t) ++)
   showsPrec _ (AppExceptionPretty t) = ("AppException: " ++) . ((Pretty.prettyErrsNoColor t) ++)
+  showsPrec _ (AppExceptionEnc e) = ((textToString $ Enc.encToTextPretty e) ++)
 
 instance (MonadIO m) => MonadLogger (AppT m) where
   monadLoggerLog loc src lvl msg = liftIO $ Logger.defaultOutput IO.stderr loc src lvl (Logger.toLogStr msg)
@@ -119,6 +121,7 @@ appThrowNewSpan spanName exc = inSpan' spanName $ \span -> do
   let msg = case exc of
         AppExceptionTree e -> prettyErrorTree e
         AppExceptionPretty p -> Pretty.prettyErrsNoColor p & stringToText
+        AppExceptionEnc e -> Enc.encToTextPretty e
   recordException
     span
     ( T2
@@ -132,6 +135,7 @@ appThrow span exc = do
   let msg = case exc of
         AppExceptionTree e -> prettyErrorTree e
         AppExceptionPretty p -> Pretty.prettyErrsNoColor p & stringToText
+        AppExceptionEnc e -> Enc.encToTextPretty e
   recordException
     span
     ( T2

users/Profpatsch/whatcd-resolver/src/Http.hs

@@ -127,8 +127,16 @@ httpJson opts parser req = inSpan' "HTTP Request (JSON)" $ \span -> do
       let res = Json.parseValue parser val
       case res of
         Left e -> do
-          let prettyErr = Json.parseErrorTreeValCtx "could not parse HTTP response" val e
-          appThrow span (AppExceptionTree prettyErr)
+          let err = Json.parseErrorTreeValCtx val e
+          appThrow
+            span
+            ( AppExceptionEnc $
+                Enc.tuple3
+                  Enc.text
+                  Enc.enc
+                  (Enc.nullOr Enc.value)
+                  ("Could not parse HTTP response", err.errorMessage, err.valueAtErrorPath)
+            )
         Right a -> pure a
 
 hush :: Either e a -> Maybe a

users/Profpatsch/whatcd-resolver/src/Redacted.hs

@@ -10,9 +10,11 @@ import Control.Monad.Logger.CallStack
 import Control.Monad.Reader
 import Data.Aeson qualified as Json
 import Data.Aeson.BetterErrors qualified as Json
+import Data.Aeson.Key qualified as Key
 import Data.Aeson.KeyMap qualified as KeyMap
 import Data.Error.Tree
 import Data.List qualified as List
+import Data.List.NonEmpty qualified as NonEmpty
 import Data.Maybe (catMaybes)
 import Database.PostgreSQL.Simple (Binary (Binary), Only (..))
 import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
@@ -37,20 +39,75 @@ instance (MonadIO m) => MonadRedacted (AppT m) where
   getRedactedApiKey = AppT (asks (.redactedApiKey))
 
 redactedSearch ::
-  (MonadThrow m, MonadOtel m, MonadRedacted m) =>
-  [(ByteString, ByteString)] ->
+  ( MonadThrow m,
+    MonadOtel m,
+    MonadRedacted m,
+    HasField "actionArgs" extraArguments [(ByteString, ByteString)],
+    HasField "page" dat (Maybe Natural)
+  ) =>
+  extraArguments ->
+  dat ->
   Json.Parse ErrorTree a ->
   m a
-redactedSearch advanced parser =
+redactedSearch extraArguments dat parser =
   inSpan' "Redacted API Search" $ \span ->
-    redactedApiRequestJson
+    redactedPagedRequest
       span
-      ( T2
+      ( T3
           (label @"action" "browse")
-          (label @"actionArgs" ((advanced <&> second Just)))
+          (getLabel @"actionArgs" extraArguments)
+          (getLabel @"page" dat)
       )
       parser
 
+redactedGetArtist ::
+  ( MonadOtel m,
+    MonadThrow m,
+    MonadRedacted m,
+    HasField "artistId" r Text,
+    HasField "page" r (Maybe Natural)
+  ) =>
+  r ->
+  Json.Parse ErrorTree a ->
+  m a
+redactedGetArtist dat parser =
+  inSpan' "Redacted Get Artist" $ \span -> do
+    redactedPagedRequest
+      span
+      ( T3
+          (label @"action" "artist")
+          (label @"actionArgs" [("id", buildBytes utf8B dat.artistId)])
+          (getLabel @"page" dat)
+      )
+      parser
+
+redactedPagedRequest ::
+  ( MonadThrow m,
+    MonadOtel m,
+    MonadRedacted m,
+    HasField "action" dat ByteString,
+    HasField "actionArgs" dat [(ByteString, ByteString)],
+    HasField "page" dat (Maybe Natural)
+  ) =>
+  Otel.Span ->
+  dat ->
+  Json.Parse ErrorTree a ->
+  m a
+redactedPagedRequest span dat parser =
+  redactedApiRequestJson
+    span
+    ( T2
+        (label @"action" dat.action)
+        ( label @"actionArgs" $
+            (dat.actionArgs <&> second Just)
+              <> ( dat.page
+                     & ifExists
+                       (\page -> ("page", Just $ buildBytes naturalDecimalB page))
+                 )
+        )
+    )
+    parser
+
 redactedGetTorrentFile ::
   ( MonadLogger m,
     MonadThrow m,
@@ -108,21 +165,143 @@ exampleSearch = do
         -- ("releasetype", "album"),
         ("order_by", "year")
       ]
-  pure (t1 >> t2 >> t3)
+  pure (t1 >> t2 >> t3 >> pure ())
 
--- | Do the search, return a transaction that inserts all results from all pages of the search.
-redactedSearchAndInsert ::
-  forall m.
+redactedRefreshArtist ::
   ( MonadLogger m,
     MonadPostgres m,
     MonadThrow m,
     MonadOtel m,
-    MonadRedacted m
+    MonadRedacted m,
+    HasField "artistId" dat Text
   ) =>
+  dat ->
+  m (Transaction m (Label "newTorrents" [Label "torrentId" Int]))
+redactedRefreshArtist dat = do
+  redactedPagedSearchAndInsert
+    (Json.key "torrentgroup" $ parseTourGroups (T2 (label @"torrentFieldName" "torrent") (label @"torrentIdName" "id")))
+    ( \page ->
+        redactedGetArtist
+          ( T2
+              (getLabel @"artistId" dat)
+              page
+          )
+    )
+
+-- | Do the search, return a transaction that inserts all results from all pages of the search.
+redactedSearchAndInsert ::
+  (MonadLogger m, MonadPostgres m, MonadThrow m, MonadOtel m, MonadRedacted m) =>
   [(ByteString, ByteString)] ->
-  m (Transaction m ())
-redactedSearchAndInsert extraArguments = do
-  logInfo [fmt|Doing redacted search with arguments: {showPretty extraArguments}|]
+  m (Transaction m (Label "newTorrents" [Label "torrentId" Int]))
+redactedSearchAndInsert extraArguments =
+  redactedPagedSearchAndInsert
+    (Json.key "results" $ parseTourGroups (T2 (label @"torrentFieldName" "torrents") (label @"torrentIdName" "torrentId")))
+    ( redactedSearch
+        (label @"actionArgs" extraArguments)
+    )
+
+-- | Parse the standard Redacted reply object, @{ status: "success", response: ... }@ or throw an error.
+--
+-- The response might contain a `pages` field, if not we’ll return 1.
+parseRedactedReplyStatus ::
+  (Monad m) =>
+  Json.ParseT ErrorTree m b ->
+  Json.ParseT ErrorTree m (T2 "pages" Natural "response" b)
+parseRedactedReplyStatus inner = do
+  status <- Json.key "status" Json.asText
+  when (status /= "success") $ do
+    Json.throwCustomError ([fmt|Status was not "success", but {status}|] :: ErrorTree)
+  Json.key "response" $ do
+    pages <-
+      Json.keyMay
+        "pages"
+        ( Field.toJsonParser
+            ( Field.mapError singleError $
+                Field.jsonNumber >>> Field.boundedScientificIntegral @Int "not an Integer" >>> Field.integralToNatural
+            )
+        )
+        -- in case the field is missing, let’s assume there is only one page
+        <&> fromMaybe 1
+    res <- inner
+    pure $
+      T2
+        (label @"pages" pages)
+        (label @"response" res)
+
+type TourGroups =
+  ( Label
+      "tourGroups"
+      [ T2
+          "tourGroup"
+          (T3 "groupId" Int "groupName" Text "fullJsonResult" Json.Value)
+          "torrents"
+          [T2 "torrentId" Int "fullJsonResult" Json.Value]
+      ]
+  )
+
+parseTourGroups ::
+  ( Monad m,
+    HasField "torrentFieldName" opts Text,
+    HasField "torrentIdName" opts Text
+  ) =>
+  opts ->
+  Json.ParseT err m TourGroups
+parseTourGroups opts =
+  do
+    label @"tourGroups"
+    <$> ( catMaybes
+            <$> ( Json.eachInArray $ do
+                    Json.keyMay opts.torrentFieldName (pure ()) >>= \case
+                      -- not a torrent group, maybe some files or something (e.g. guitar tabs see Dream Theater Systematic Chaos)
+                      Nothing -> pure Nothing
+                      Just () -> do
+                        groupId <- Json.keyLabel @"groupId" "groupId" (Json.asIntegral @_ @Int)
+                        groupName <- Json.keyLabel @"groupName" "groupName" Json.asText
+                        fullJsonResult <-
+                          label @"fullJsonResult"
+                            <$> ( Json.asObject
+                                    -- remove torrents cause they are inserted separately below
+                                    <&> KeyMap.filterWithKey (\k _ -> k /= (opts.torrentFieldName & Key.fromText))
+                                    <&> Json.Object
+                                )
+                        let tourGroup = T3 groupId groupName fullJsonResult
+                        torrents <- Json.keyLabel @"torrents" opts.torrentFieldName $
+                          Json.eachInArray $ do
+                            torrentId <- Json.keyLabel @"torrentId" opts.torrentIdName (Json.asIntegral @_ @Int)
+                            fullJsonResultT <-
+                              label @"fullJsonResult"
+                                <$> ( Json.asObject
+                                        <&> KeyMap.mapKeyVal
+                                          ( \k ->
+                                              if
+                                                -- some torrent objects use “snatched” instead of “snatches”
+                                                | k == "snatched" -> "snatches"
+                                                -- normalize the torrent id field
+                                                | k == (opts.torrentIdName & Key.fromText) -> "torrentId"
+                                                | otherwise -> k
+                                          )
+                                          id
+                                        <&> Json.Object
+                                    )
+                            pure $ T2 torrentId fullJsonResultT
+                        pure $ Just (T2 (label @"tourGroup" tourGroup) torrents)
+                )
+        )
+
+redactedPagedSearchAndInsert ::
+  forall m.
+  ( MonadLogger m,
+    MonadPostgres m
+  ) =>
+  Json.Parse ErrorTree TourGroups ->
+  -- | A redacted request that returns a paged result
+  ( forall a.
+    Label "page" (Maybe Natural) ->
+    Json.Parse ErrorTree a ->
+    m a
+  ) ->
+  m (Transaction m (Label "newTorrents" [Label "torrentId" Int]))
+redactedPagedSearchAndInsert innerParser pagedRequest = do
   -- The first search returns the amount of pages, so we use that to query all results piece by piece.
   firstPage <- go Nothing
   let remainingPages = firstPage.pages - 1
@@ -131,58 +310,17 @@ redactedSearchAndInsert extraArguments = do
   otherPages <- traverse go (Just <$> otherPagesNum)
   pure $
     (firstPage : otherPages)
-      & concatMap (.tourGroups)
+      & concatMap (.response.tourGroups)
       & \case
-        IsNonEmpty tgs -> tgs & insertTourGroupsAndTorrents
-        IsEmpty -> pure ()
+        IsNonEmpty tgs -> do
+          tgs & insertTourGroupsAndTorrents
+          pure $ label @"newTorrents" (tgs & concatMap (\tg -> tg.torrents <&> getLabel @"torrentId"))
+        IsEmpty -> pure $ label @"newTorrents" []
   where
     go mpage =
-      redactedSearch
-        ( extraArguments
-            -- pass the page (for every search but the first one)
-            <> (mpage & ifExists (\page -> ("page", buildBytes naturalDecimalB page)))
-        )
-        ( do
-            status <- Json.key "status" Json.asText
-            when (status /= "success") $ do
-              Json.throwCustomError [fmt|Status was not "success", but {status}|]
-            Json.key "response" $ do
-              pages <-
-                Json.keyMay "pages" (Field.toJsonParser (Field.mapError singleError $ Field.jsonNumber >>> Field.boundedScientificIntegral @Int "not an Integer" >>> Field.integralToNatural))
-                  -- in case the field is missing, let’s assume there is only one page
-                  <&> fromMaybe 1
-              Json.key "results" $ do
-                tourGroups <-
-                  label @"tourGroups"
-                    <$> ( catMaybes
-                            <$> ( Json.eachInArray $ do
-                                    Json.keyMay "torrents" (pure ()) >>= \case
-                                      -- not a torrent group, maybe some files or something (e.g. guitar tabs see Dream Theater Systematic Chaos)
-                                      Nothing -> pure Nothing
-                                      Just () -> do
-                                        groupId <- Json.keyLabel @"groupId" "groupId" (Json.asIntegral @_ @Int)
-                                        groupName <- Json.keyLabel @"groupName" "groupName" Json.asText
-                                        fullJsonResult <-
-                                          label @"fullJsonResult"
-                                            <$> ( Json.asObject
-                                                    -- remove torrents cause they are inserted separately below
-                                                    <&> KeyMap.filterWithKey (\k _ -> k /= "torrents")
-                                                    <&> Json.Object
-                                                )
-                                        let tourGroup = T3 groupId groupName fullJsonResult
-                                        torrents <- Json.keyLabel @"torrents" "torrents" $
-                                          Json.eachInArray $ do
-                                            torrentId <- Json.keyLabel @"torrentId" "torrentId" (Json.asIntegral @_ @Int)
-                                            fullJsonResultT <- label @"fullJsonResult" <$> Json.asValue
-                                            pure $ T2 torrentId fullJsonResultT
-                                        pure $ Just (T2 (label @"tourGroup" tourGroup) torrents)
-                                )
-                        )
-                pure
-                  ( T2
-                      (label @"pages" pages)
-                      tourGroups
-                  )
+      pagedRequest
+        (label @"page" mpage)
+        ( parseRedactedReplyStatus $ innerParser
         )
     insertTourGroupsAndTorrents ::
       NonEmpty
@@ -238,11 +376,15 @@ redactedSearchAndInsert extraArguments = do
                 full_json_result = excluded.full_json_result
               RETURNING (id)
             |]
-        ( dats <&> \dat ->
-            ( dat.groupId,
-              dat.groupName,
-              dat.fullJsonResult
-            )
+        ( dats
+            -- make sure we don’t have the same conflict target twice
+            & NonEmpty.nubBy (\a b -> a.groupId == b.groupId)
+            <&> ( \dat ->
+                    ( dat.groupId,
+                      dat.groupName,
+                      dat.fullJsonResult
+                    )
+                )
         )
         (label @"tourGroupIdPg" <$> Dec.fromField @Int)
 
@@ -292,6 +434,7 @@ redactedSearchAndInsert extraArguments = do
             | dat <- dats,
               group <- dat.torrents
           ]
+            & List.nubBy (\a b -> a.torrentId == b.torrentId)
             & unzip3PGArray
               @"torrentGroupIdPg"
               @Int
@@ -455,7 +598,8 @@ getTorrentById dat = do
 
 data GetBestTorrentsFilter = GetBestTorrentsFilter
   { onlyDownloaded :: Bool,
-    onlyArtist :: Maybe (Label "artistRedactedId" Natural)
+    onlyArtist :: Maybe (Label "artistRedactedId" Natural),
+    onlyTheseTorrents :: Maybe ([Label "torrentId" Int])
   }
 
 -- | Find the best torrent for each torrent group (based on the seeding_weight)
@@ -477,6 +621,9 @@ getBestTorrents opts = do
           -- filter by artist id
           AND
           (?::bool OR (to_jsonb(?::int) <@ (jsonb_path_query_array(full_json_result, '$.artists[*].id'))))
+          -- filter by torrent ids
+          AND
+          (?::bool OR torrent_id = ANY (?::int[]))
         ORDER BY
           torrent_group,
           -- prefer torrents which we already downloaded
@@ -488,7 +635,12 @@ getBestTorrents opts = do
         t.torrent_id,
         t.seeding_weight,
         tg.full_json_result->>'releaseType' AS release_type,
-        t.full_json_result->'artists' AS artists,
+        -- TODO: different endpoints handle this differently (e.g. action=search and action=artist), we should unify this while parsing
+        COALESCE(
+          t.full_json_result->'artists',
+          tg.full_json_result->'artists',
+          '[]'::jsonb
+        ) as artists,
         tg.full_json_result->>'groupName' AS group_name,
         tg.full_json_result->>'groupYear' AS group_year,
         t.torrent_file IS NOT NULL AS has_torrent_file,
@@ -503,9 +655,14 @@ getBestTorrents opts = do
         let (onlyArtistB, onlyArtistId) = case opts.onlyArtist of
               Nothing -> (True, 0)
               Just a -> (False, a.artistRedactedId)
+        let (onlyTheseTorrentsB, onlyTheseTorrents) = case opts.onlyTheseTorrents of
+              Nothing -> (True, PGArray [])
+              Just a -> (False, a <&> (.torrentId) & PGArray)
         ( opts.onlyDownloaded :: Bool,
           onlyArtistB :: Bool,
-          onlyArtistId & fromIntegral @Natural @Int
+          onlyArtistId & fromIntegral @Natural @Int,
+          onlyTheseTorrentsB :: Bool,
+          onlyTheseTorrents
           )
     )
     ( do
@@ -610,12 +767,12 @@ redactedApiRequestJson span dat parser = do
   mkRedactedApiRequest dat
     >>= Http.httpJson defaults parser
 
--- test :: (MonadThrow m, MonadRedacted m, MonadOtel m) => m ()
--- test =
---   inSpan' "test" $ \span -> do
---     redactedApiRequestJson
---       span
---       (T2 (label @"action" "browse") (label @"actionArgs" [("searchstr", Just "dream theater")]))
---       (Json.asValue)
---       <&> Pretty.showPrettyJson
---       >>= liftIO . putStderrLn
+test :: (MonadThrow m, MonadRedacted m, MonadOtel m) => m ()
+test =
+  inSpan' "test" $ \span -> do
+    redactedApiRequestJson
+      span
+      (T2 (label @"action" "artist") (label @"actionArgs" [("id", Just "2785")]))
+      (Json.asValue)
+      <&> Pretty.showPrettyJsonColored
+      >>= liftIO . putStderrLn

users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs

@@ -14,6 +14,7 @@ import Control.Monad.Reader
 import Data.Aeson qualified as Json
 import Data.Aeson.BetterErrors qualified as Json
 import Data.Aeson.KeyMap qualified as KeyMap
+import Data.CaseInsensitive (CI)
 import Data.Error.Tree
 import Data.HashMap.Strict qualified as HashMap
 import Data.List qualified as List
@@ -100,6 +101,9 @@ htmlUi = do
             Left (AppExceptionPretty err) -> do
               runInIO (logError (err & Pretty.prettyErrsNoColor & stringToText))
               respondOrig (Wai.responseLBS Http.status500 [] "")
+            Left (AppExceptionEnc err) -> do
+              runInIO (logError (Enc.encToTextPrettyColored err))
+              respondOrig (Wai.responseLBS Http.status500 [] "")
 
     catchAppException $ do
       let mp span parser =
@@ -132,7 +136,27 @@ htmlUi = do
                           ( do
                               label @"searchstr" <$> Multipart.field "redacted-search" Cat.id
                           )
-                      snipsRedactedSearch dat
+                      t <- redactedSearchAndInsert [("searchstr", dat.searchstr)]
+                      runTransaction $ do
+                        res <- t
+                        table <-
+                          getBestTorrentsTable
+                            (label @"groupByReleaseType" True)
+                            ( Just (E21 (label @"onlyTheseTorrents" res.newTorrents)) ::
+                                ( Maybe
+                                    ( E2
+                                        "onlyTheseTorrents"
+                                        [Label "torrentId" Int]
+                                        "artistRedactedId"
+                                        Natural
+                                    )
+                                )
+                            )
+                        pure
+                          [hsx|
+                          <h1>Search results for <pre>{dat.searchstr}</pre></h1>
+                          {table}
+                        |]
                 ),
                 ( "snips/redacted/torrentDataJson",
                   respond.html $ \span -> do
@@ -226,6 +250,18 @@ htmlUi = do
                       $ \qry _span -> do
                         artistPage qry
                 ),
+                ( "artist/refresh",
+                  respond.htmlOrRedirect $
+                    \span -> do
+                      dat <-
+                        mp
+                          span
+                          (label @"artistId" <$> Multipart.field "artist-id" Field.utf8)
+                      t <- redactedRefreshArtist dat
+                      runTransaction $ do
+                        t
+                      pure $ E22 (label @"redirectTo" [fmt|/artist?redacted_id={dat.artistId}|])
+                ),
                 ( "autorefresh",
                   respond.plain $ do
                     qry <-
@@ -264,7 +300,7 @@ htmlUi = do
       --       "https://musicbrainz.org/work/92000fd4-d304-406d-aeb4-6bdbeed318ec"
       --     )
       --     <&> renderJsonld
-      bestTorrentsTable <- getBestTorrentsTable Nothing
+      bestTorrentsTable <- getBestTorrentsTable (label @"groupByReleaseType" False) Nothing
       -- transmissionTorrentsTable <- lift @Transaction getTransmissionTorrentsTable
       pure $
         htmlPageChrome
@@ -299,15 +335,23 @@ htmlUi = do
 
 -- | Reload the current page (via the Referer header) if the browser has Javascript disabled (and thus htmx does not work). This should make post requests work out of the box.
 htmxOrReferer :: Wai.Request -> Wai.Response -> Wai.Response
-htmxOrReferer req act = do
+htmxOrReferer req resp = do
   let fnd h = req & Wai.requestHeaders & List.find (\(hdr, _) -> hdr == h)
   let referer = fnd "Referer"
   if
-    | Just _ <- fnd "Hx-Request" -> act
-    | Nothing <- referer -> act
+    | Just _ <- fnd "Hx-Request" -> resp
+    | Nothing <- referer -> resp
     | Just (_, rfr) <- referer -> do
         Wai.responseLBS seeOther303 [("Location", rfr)] ""
 
+-- | Redirect to the given page, if the browser has Javascript enabled use HTMX client side redirect, otherwise use a normal HTTP redirect.
+redirectOrFallback :: ByteString -> (Status -> (CI ByteString, ByteString) -> Wai.Response) -> Wai.Request -> Wai.Response
+redirectOrFallback target responseFn req = do
+  let fnd h = req & Wai.requestHeaders & List.find (\(hdr, _) -> hdr == h)
+  case fnd "Hx-Request" of
+    Just _ -> responseFn Http.ok200 ("Hx-Redirect", target)
+    Nothing -> responseFn Http.seeOther303 ("Location", target)
+
 htmlPageChrome :: (ToHtml a) => Text -> a -> Html
 htmlPageChrome title body =
   Html.docTypeHtml $
@@ -352,9 +396,10 @@ artistPage ::
 artistPage dat = runTransaction $ do
   fresh <-
     getBestTorrentsData
-      (Just $ getLabel @"artistRedactedId" dat)
+      (Just $ E22 (getLabel @"artistRedactedId" dat))
   let artistName = fresh & findMaybe (\t -> t.artists & findMaybe (\a -> if a.artistId == (dat.artistRedactedId & fromIntegral @Natural @Int) then Just a.artistName else Nothing))
   let torrents = mkBestTorrentsTable (label @"groupByReleaseType" True) fresh
+
   pure $
     htmlPageChrome
       ( case artistName of
@@ -362,9 +407,22 @@ artistPage dat = runTransaction $ do
           Just a -> [fmt|{a} - Artist Page - whatcd-resolver|]
       )
       [hsx|
-        Artist ID: {dat.artistRedactedId}
+        <p>Artist ID: {dat.artistRedactedId}</p>
 
-        {torrents}
+        <div id="artist-torrents">
+          {torrents}
+        </div>
+
+        <form method="post" action="artist/refresh" hx-post="artist/refresh">
+          <input
+            hidden
+            type="text"
+            name="artist-id"
+            value={dat.artistRedactedId & buildText naturalDecimalT}
+            />
+          <button type="submit" hx-disabled-elt="this">Refresh Artist Page</button>
+          <div class="htmx-indicator">Refreshing!</div>
+        </form>
       |]
 
 type Handlers m = HandlerResponses m -> Map Text (m ResponseReceived)
@@ -372,6 +430,8 @@ type Handlers m = HandlerResponses m -> Map Text (m ResponseReceived)
 data HandlerResponses m = HandlerResponses
   { -- | render html
     html :: (Otel.Span -> m Html) -> m ResponseReceived,
+    -- | either render html or redirect to another page
+    htmlOrRedirect :: (Otel.Span -> m (E2 "respond" Html "redirectTo" ByteString)) -> m ResponseReceived,
     -- | render html after parsing some query arguments
     htmlWithQueryArgs :: forall a. (Parse Query a -> (a -> Otel.Span -> m Html) -> m ResponseReceived),
     -- | render html or reload the page via the Referer header if no htmx
@@ -381,6 +441,7 @@ data HandlerResponses m = HandlerResponses
   }
 
 runHandlers ::
+  forall m.
   (MonadOtel m) =>
   (HandlerResponses m -> m ResponseReceived) ->
   (HandlerResponses m -> Map Text (m ResponseReceived)) ->
@@ -401,18 +462,26 @@ runHandlers defaultHandler handlers req respond = withRunInIO $ \runInIO -> do
               }
           )
           ( \span -> do
-              res <- act span <&> (\h -> T2 (label @"html" h) (label @"extraHeaders" []))
+              res <- act span <&> (\h -> label @"html" h)
               addEventSimple span "Got Html result, rendering…"
               liftIO $ respond (resp res)
           )
-  let htmlResp res = Wai.responseLBS Http.ok200 ([("Content-Type", "text/html")] <> res.extraHeaders) . Html.renderHtml $ res.html
+  let htmlResp res = Wai.responseLBS Http.ok200 ([("Content-Type", "text/html")]) . Html.renderHtml $ res.html
   let html = html' htmlResp
   let htmlOrReferer = html' $ \res -> htmxOrReferer req (htmlResp res)
-
+  let htmlOrRedirect :: (Otel.Span -> m (E2 "respond" Html "redirectTo" ByteString)) -> m ResponseReceived
+      htmlOrRedirect = html' $ \res -> case res.html of
+        E21 h -> htmlResp (label @"html" h.respond)
+        E22 r ->
+          redirectOrFallback
+            r.redirectTo
+            (\status header -> Wai.responseLBS status [header] "")
+            req
   let handlerResponses =
         ( HandlerResponses
             { plain = (\m -> liftIO $ runInIO m >>= respond),
               html,
+              htmlOrRedirect,
               htmlWithQueryArgs = \parser act ->
                 case req & Parse.runParse "Unable to find the right request query arguments" (lmap Wai.queryString parser) of
                   Right a -> html (act a)
@@ -513,26 +582,6 @@ checkException some = case fromException some of
   Nothing -> Left some
   Just e -> Right e
 
-snipsRedactedSearch ::
-  ( MonadLogger m,
-    MonadPostgres m,
-    HasField "searchstr" r ByteString,
-    MonadThrow m,
-    MonadTransmission m,
-    MonadOtel m,
-    MonadRedacted m
-  ) =>
-  r ->
-  m Html
-snipsRedactedSearch dat = do
-  t <-
-    redactedSearchAndInsert
-      [ ("searchstr", dat.searchstr)
-      ]
-  runTransaction $ do
-    t
-    getBestTorrentsTable (Nothing :: Maybe (Label "artistRedactedId" Natural))
-
 data ArtistFilter = ArtistFilter
   { onlyArtist :: Maybe (Label "artistId" Text)
   }
@@ -542,13 +591,15 @@ getBestTorrentsTable ::
     MonadThrow m,
     MonadLogger m,
     MonadPostgres m,
-    MonadOtel m
+    MonadOtel m,
+    HasField "groupByReleaseType" opts Bool
   ) =>
-  Maybe (Label "artistRedactedId" Natural) ->
+  opts ->
+  Maybe (E2 "onlyTheseTorrents" [Label "torrentId" Int] "artistRedactedId" Natural) ->
   Transaction m Html
-getBestTorrentsTable dat = do
+getBestTorrentsTable opts dat = do
   fresh <- getBestTorrentsData dat
-  pure $ mkBestTorrentsTable (label @"groupByReleaseType" False) fresh
+  pure $ mkBestTorrentsTable opts fresh
 
 doIfJust :: (Applicative f) => (a -> f ()) -> Maybe a -> f ()
 doIfJust = traverse_
@@ -560,11 +611,15 @@ getBestTorrentsData ::
     MonadPostgres m,
     MonadOtel m
   ) =>
-  Maybe (Label "artistRedactedId" Natural) ->
+  Maybe (E2 "onlyTheseTorrents" [Label "torrentId" Int] "artistRedactedId" Natural) ->
   Transaction m [TorrentData (Label "percentDone" Percentage)]
-getBestTorrentsData artistFilter = inSpan' "get torrents table data" $ \span -> do
-  artistFilter & doIfJust (\a -> addAttribute span "artist-filter.redacted-id" (a.artistRedactedId, naturalDecimalT))
-  let getBest = getBestTorrents GetBestTorrentsFilter {onlyArtist = artistFilter, onlyDownloaded = False}
+getBestTorrentsData filters = inSpan' "get torrents table data" $ \span -> do
+  let onlyArtist = label @"artistRedactedId" <$> (filters >>= getE22 @"artistRedactedId")
+  onlyArtist & doIfJust (\a -> addAttribute span "artist-filter.redacted-id" (a.artistRedactedId, naturalDecimalT))
+  let onlyTheseTorrents = filters >>= getE21 @"onlyTheseTorrents"
+  onlyTheseTorrents & doIfJust (\a -> addAttribute span "torrent-filter.ids" (a <&> (getLabel @"torrentId") & showToText & Otel.toAttribute))
+
+  let getBest = getBestTorrents GetBestTorrentsFilter {onlyDownloaded = False, ..}
   bestStale :: [TorrentData ()] <- getBest
   (statusInfo, transmissionStatus) <-
     getAndUpdateTransmissionTorrentsStatus
@@ -589,7 +644,16 @@ getBestTorrentsData artistFilter = inSpan' "get torrents table data" $ \span ->
       else pure bestStale
   pure $
     bestBest
-      & filter (\td -> td.releaseType /= releaseTypeCompilation)
+      -- filter out some kinds we don’t really care about
+      & filter
+        ( \td ->
+            td.releaseType
+              `List.notElem` [ releaseTypeCompilation,
+                               releaseTypeDJMix,
+                               releaseTypeMixtape,
+                               releaseTypeRemix
+                             ]
+        )
       --  we have to update the status of every torrent that’s not in tranmission anymore
       -- TODO I feel like it’s easier (& more correct?) to just do the database request again …
       <&> ( \td -> case td.torrentStatus of
@@ -603,7 +667,11 @@ getBestTorrentsData artistFilter = inSpan' "get torrents table data" $ \span ->
               NoTorrentFileYet -> td {torrentStatus = NoTorrentFileYet}
           )
 
-mkBestTorrentsTable :: Label "groupByReleaseType" Bool -> [TorrentData (Label "percentDone" Percentage)] -> Html
+mkBestTorrentsTable ::
+  (HasField "groupByReleaseType" opts Bool) =>
+  opts ->
+  [TorrentData (Label "percentDone" Percentage)] ->
+  Html
 mkBestTorrentsTable opts fresh = do
   let localTorrent b = case b.torrentStatus of
         NoTorrentFileYet ->
@@ -806,7 +874,7 @@ migrate = inSpan "Database Migration" $ do
     $$ LANGUAGE plpgsql IMMUTABLE;
 
     ALTER TABLE redacted.torrents_json
-    ADD COLUMN IF NOT EXISTS seeding_weight int GENERATED ALWAYS AS (calc_seeding_weight(full_json_result)) STORED;
+    ADD COLUMN IF NOT EXISTS seeding_weight int NOT NULL GENERATED ALWAYS AS (calc_seeding_weight(full_json_result)) STORED;
 
     -- inflect out values of the full json
     CREATE OR REPLACE VIEW redacted.torrents AS
@@ -862,6 +930,7 @@ runAppWith appT = withTracer $ \tracer -> withDb $ \db -> do
     `catch` ( \case
                 AppExceptionPretty p -> throwM $ EscapedException (p & Pretty.prettyErrs)
                 AppExceptionTree t -> throwM $ EscapedException (t & prettyErrorTree & textToString)
+                AppExceptionEnc e -> throwM $ EscapedException (e & Enc.encToTextPrettyColored & textToString)
             )
 
 -- | Just a silly wrapper so that correctly format any 'AppException' that would escape the runAppWith scope.