feat(users/Profpatsch/whatcd-resolver): Add server-side search r/6417

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

5 files changed, 462 insertions, 81 deletions

diff --git a/users/Profpatsch/whatcd-resolver/src/Multipart2.hs b/users/Profpatsch/whatcd-resolver/src/Multipart2.hs
new file mode 100644
index 0000000000..17246546ab
--- /dev/null
+++ b/users/Profpatsch/whatcd-resolver/src/Multipart2.hs
@@ -0,0 +1,220 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Multipart2 where
+
+import Control.Monad.Logger (MonadLogger)
+import Control.Selective (Selective)
+import Data.ByteString.Lazy qualified as Lazy
+import Data.DList (DList)
+import Data.DList qualified as DList
+import Data.Error.Tree
+import Data.Functor.Compose
+import Data.List qualified as List
+import FieldParser
+import Label
+import Network.Wai qualified as Wai
+import Network.Wai.Parse qualified as Wai
+import PossehlAnalyticsPrelude
+import ValidationParseT
+
+data FormFields = FormFields
+  { inputs :: [Wai.Param],
+    files :: [MultipartFile Lazy.ByteString]
+  }
+
+-- | A parser for a HTTP multipart form (a form sent by the browser)
+newtype MultipartParseT backend m a = MultipartParseT
+  { unMultipartParseT ::
+      FormFields ->
+      m (Validation (NonEmpty Error) a)
+  }
+  deriving
+    (Functor, Applicative, Selective)
+    via (ValidationParseT FormFields m)
+
+-- | After parsing a form, either we get the result or a list of form fields that failed
+newtype FormValidation a
+  = FormValidation
+      (DList FormValidationResult, Maybe a)
+  deriving (Functor, Applicative, Selective) via (Compose ((,) (DList FormValidationResult)) Maybe)
+  deriving stock (Show)
+
+data FormValidationResult = FormValidationResult
+  { hasError :: Maybe Error,
+    formFieldName :: ByteString,
+    originalValue :: ByteString
+  }
+  deriving stock (Show)
+
+mkFormValidationResult ::
+  ( HasField "formFieldName" form ByteString,
+    HasField "originalValue" form ByteString
+  ) =>
+  form ->
+  Maybe Error ->
+  FormValidationResult
+mkFormValidationResult form err =
+  FormValidationResult
+    { hasError = err,
+      formFieldName = form.formFieldName,
+      originalValue = form.originalValue
+    }
+
+eitherToFormValidation ::
+  ( HasField "formFieldName" form ByteString,
+    HasField "originalValue" form ByteString
+  ) =>
+  form ->
+  Either Error a ->
+  FormValidation a
+eitherToFormValidation form = \case
+  Left err ->
+    FormValidation $ (DList.singleton $ mkFormValidationResult form (Just err), Nothing)
+  Right a ->
+    FormValidation $ ((DList.singleton $ mkFormValidationResult form Nothing), Just a)
+
+failFormValidation ::
+  ( HasField "formFieldName" form ByteString,
+    HasField "originalValue" form ByteString
+  ) =>
+  form ->
+  Error ->
+  FormValidation a
+failFormValidation form err =
+  FormValidation (DList.singleton $ mkFormValidationResult form (Just err), Nothing)
+
+-- | Parse the multipart form or throw a user error with a descriptive error message.
+parseMultipartOrThrow ::
+  (MonadLogger m, MonadIO m) =>
+  (ErrorTree -> m a) ->
+  MultipartParseT backend m a ->
+  Wai.Request ->
+  m a
+parseMultipartOrThrow throwF parser req = do
+  -- TODO: this throws all errors with `error`, so leads to 500 on bad input …
+  formFields <-
+    liftIO $
+      Wai.parseRequestBodyEx
+        Wai.defaultParseRequestBodyOptions
+        Wai.lbsBackEnd
+        req
+  parser.unMultipartParseT
+    FormFields
+      { inputs = fst formFields,
+        files = map fileDataToMultipartFile $ snd formFields
+      }
+    >>= \case
+      Failure errs -> throwF (errorTree "Cannot parse the multipart form" errs)
+      Success a -> pure a
+
+-- | Parse the field out of the multipart message
+field :: Applicative m => ByteString -> FieldParser ByteString a -> MultipartParseT backend m a
+field fieldName fieldParser = MultipartParseT $ \mp ->
+  mp.inputs
+    & findMaybe (\input -> if fst input == fieldName then Just (snd input) else Nothing)
+    & annotate [fmt|Field "{fieldName}" does not exist in the multipart form|]
+    >>= runFieldParser fieldParser
+    & eitherToListValidation
+    & pure
+
+-- | Parse the field out of the multipart message
+field' :: Applicative m => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (FormValidation a)
+field' fieldName fieldParser = MultipartParseT $ \mp ->
+  mp.inputs
+    & findMaybe (\input -> if fst input == fieldName then Just $ snd input else Nothing)
+    & annotate [fmt|Field "{fieldName}" does not exist in the multipart form|]
+    <&> ( \originalValue ->
+            originalValue
+              & runFieldParser fieldParser
+              & eitherToFormValidation
+                ( T2
+                    (label @"formFieldName" fieldName)
+                    (label @"originalValue" originalValue)
+                )
+        )
+    & eitherToListValidation
+    & pure
+
+-- | Parse the field out of the multipart message, and into a 'Label' of the given name.
+fieldLabel :: forall lbl backend m a. Applicative m => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (Label lbl a)
+fieldLabel fieldName fieldParser = label @lbl <$> field fieldName fieldParser
+
+-- | Parse the field out of the multipart message, and into a 'Label' of the given name.
+fieldLabel' :: forall lbl backend m a. Applicative m => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (FormValidation (Label lbl a))
+fieldLabel' fieldName fieldParser = fmap (label @lbl) <$> field' fieldName fieldParser
+
+-- | parse all fields out of the multipart message, with the same parser
+allFields :: Applicative m => FieldParser (T2 "key" ByteString "value" ByteString) b -> MultipartParseT backend m [b]
+allFields fieldParser = MultipartParseT $ \mp ->
+  mp.inputs
+    <&> tupToT2 @"key" @"value"
+    & traverseValidate (runFieldParser fieldParser)
+    & eitherToValidation
+    & pure
+
+tupToT2 :: forall l1 l2 t1 t2. (t1, t2) -> T2 l1 t1 l2 t2
+tupToT2 (a, b) = T2 (label a) (label b)
+
+-- | Parse a file by name out of the multipart message
+file ::
+  Applicative m =>
+  ByteString ->
+  MultipartParseT backend m (MultipartFile Lazy.ByteString)
+file fieldName = MultipartParseT $ \mp ->
+  mp.files
+    & List.find (\input -> input.multipartNameAttribute == fieldName)
+    & annotate [fmt|File "{fieldName}" does not exist in the multipart form|]
+    & ( \case
+          Left err -> Failure (singleton err)
+          Right filePath -> Success filePath
+      )
+    & pure
+
+-- | Return all files from the multipart message
+allFiles ::
+  Applicative m =>
+  MultipartParseT backend m [MultipartFile Lazy.ByteString]
+allFiles = MultipartParseT $ \mp -> do
+  pure $ Success $ mp.files
+
+-- | Ensure there is exactly one file and return it (ignoring the field name)
+exactlyOneFile ::
+  Applicative m =>
+  MultipartParseT backend m (MultipartFile Lazy.ByteString)
+exactlyOneFile = MultipartParseT $ \mp ->
+  mp.files
+    & \case
+      [] -> pure $ failParse "Expected to receive a file, but the multipart form did not contain any files"
+      [file_] -> pure $ Success file_
+      more -> pure $ failParse [fmt|Expected to receive exactly one file, but the multipart form contained {List.length more} files|]
+  where
+    -- \| Fail to parse the multipart form with the given error message.
+    failParse :: Text -> Validation (NonEmpty Error) a
+    failParse = Failure . singleton . newError
+
+newtype GetFileContent backend m content = GetFileContent
+  {unGetFileContent :: (Wai.Request -> m (Either Error content))}
+
+-- | A file field in a multipart message.
+data MultipartFile content = MultipartFile
+  { -- | @name@ attribute of the corresponding HTML @\<input\>@
+    multipartNameAttribute :: ByteString,
+    -- | name of the file on the client's disk
+    fileNameOnDisk :: ByteString,
+    -- | MIME type for the file
+    fileMimeType :: ByteString,
+    -- | Content of the file
+    content :: content
+  }
+
+-- | Convert the multipart library struct of a multipart file to our own.
+fileDataToMultipartFile ::
+  Wai.File Lazy.ByteString ->
+  (MultipartFile Lazy.ByteString)
+fileDataToMultipartFile (multipartNameAttribute, file_) = do
+  MultipartFile
+    { multipartNameAttribute,
+      fileNameOnDisk = file_.fileName,
+      fileMimeType = file_.fileContentType,
+      content = file_.fileContent
+    }
diff --git a/users/Profpatsch/whatcd-resolver/src/Postgres/MonadPostgres.hs b/users/Profpatsch/whatcd-resolver/src/Postgres/MonadPostgres.hs
index 012cf0caac..e602ee287f 100644
--- a/users/Profpatsch/whatcd-resolver/src/Postgres/MonadPostgres.hs
+++ b/users/Profpatsch/whatcd-resolver/src/Postgres/MonadPostgres.hs
@@ -369,6 +369,9 @@ pgFormatQueryByteString queryBytes = do
         logDebug [fmt|pg_format stdout: stderr|]
         pure (queryBytes & bytesToTextUtf8Lenient)
 
+instance (ToField t1) => ToRow (Label l1 t1) where
+  toRow t2 = toRow $ PG.Only $ getField @l1 t2
+
 instance (ToField t1, ToField t2) => ToRow (T2 l1 t1 l2 t2) where
   toRow t2 = toRow (getField @l1 t2, getField @l2 t2)
 
diff --git a/users/Profpatsch/whatcd-resolver/src/ValidationParseT.hs b/users/Profpatsch/whatcd-resolver/src/ValidationParseT.hs
index 62322a0ac0..593b7ebf39 100644
--- a/users/Profpatsch/whatcd-resolver/src/ValidationParseT.hs
+++ b/users/Profpatsch/whatcd-resolver/src/ValidationParseT.hs
@@ -1,5 +1,6 @@
 module ValidationParseT where
 
+import Control.Selective (Selective)
 import Data.Functor.Compose (Compose (..))
 import PossehlAnalyticsPrelude
 
@@ -8,7 +9,7 @@ import PossehlAnalyticsPrelude
 -- Use with DerivingVia. Grep codebase for examples.
 newtype ValidationParseT env m a = ValidationParseT {unValidationParseT :: env -> m (Validation (NonEmpty Error) a)}
   deriving
-    (Functor, Applicative)
+    (Functor, Applicative, Selective)
     via ( Compose
             ((->) env)
             (Compose m (Validation (NonEmpty Error)))
diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
index c4aab4bee6..c33ddd62d6 100644
--- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -4,6 +4,7 @@
 
 module WhatcdResolver where
 
+import Control.Category qualified as Cat
 import Control.Monad.Logger qualified as Logger
 import Control.Monad.Logger.CallStack
 import Control.Monad.Reader
@@ -29,6 +30,7 @@ import Json qualified
 import Json.Enc (Enc)
 import Json.Enc qualified as Enc
 import Label
+import Multipart2 qualified as Multipart
 import Network.HTTP.Conduit qualified as Http
 import Network.HTTP.Simple qualified as Http
 import Network.HTTP.Types
@@ -53,11 +55,34 @@ import UnliftIO
 htmlUi :: App ()
 htmlUi = do
   withRunInIO $ \runInIO -> Warp.run 8080 $ \req resp -> do
-    let h = resp . Wai.responseLBS Http.ok200 []
-    case req & Wai.pathInfo of
-      [] -> h =<< runInIO mainHtml
-      ["snips", "song"] -> h snipsSong
-      _ -> h =<< runInIO mainHtml
+    let h act = do
+          res <- runInIO act
+          resp . Wai.responseLBS Http.ok200 [("Content-Type", "text/html")] . Html.renderHtml $ res
+    let mp parser =
+          Multipart.parseMultipartOrThrow
+            appThrowTree
+            parser
+            req
+
+    case req & Wai.pathInfo & Text.intercalate "/" of
+      "" -> h mainHtml
+      "snips/song" -> h snipsSong
+      "snips/redacted/search" -> do
+        h $ do
+          dat <-
+            mp
+              ( do
+                  label @"searchstr" <$> Multipart.field "redacted-search" Cat.id
+              )
+          snipsRedactedSearch dat
+      "snips/redacted/torrentDataJson" -> h $ do
+        dat <-
+          mp
+            ( do
+                label @"id" <$> Multipart.field "torrent-id" ((Field.utf8 >>> Field.signedDecimal >>> Field.bounded @Int "int"))
+            )
+        mkVal <$> (runTransaction $ getTorrentById dat)
+      _ -> h mainHtml
   where
     tableData =
       ( [ "Group ID",
@@ -78,17 +103,16 @@ htmlUi = do
       )
 
     mkTable :: ([Text], t -> [Enc]) -> [t] -> Html
-    mkTable f ts =
-      do
-        let headers = Html.thead (fst f <&> Html.toHtml @Text <&> Html.th & mconcat)
-        let keys = fst f <&> Text.toLower <&> Text.replace " " "_"
-        let json = Enc.list (\t -> Enc.object (zip keys (t & snd f))) ts
-        let tableDataScript =
-              Html.script
-                ! Attr.type_ "application/json"
-                ! Attr.id "table-data"
-                $ (json & Enc.encToBytesUtf8 & bytesToTextUtf8Unsafe & Html.text)
-        [hsx|
+    mkTable f ts = do
+      let headers = Html.thead (fst f <&> Html.toHtml @Text <&> Html.th & mconcat)
+      let keys = fst f <&> Text.toLower <&> Text.replace " " "_"
+      let json = Enc.list (\t -> Enc.object (zip keys (t & snd f))) ts
+      let tableDataScript =
+            Html.script
+              ! Attr.type_ "application/json"
+              ! Attr.id "table-data"
+              $ (json & Enc.encToBytesUtf8 & bytesToTextUtf8Unsafe & Html.text)
+      [hsx|
         {tableDataScript}
         <table id="table" class="table">
           {headers}
@@ -104,16 +128,15 @@ htmlUi = do
           } )
         </script>
       |]
+
     mainHtml = runTransaction $ do
       bestTorrents <- getBestTorrents
       pure $
-        Html.renderHtml $
-          Html.docTypeHtml
-            [hsx|
+        Html.docTypeHtml
+          [hsx|
       <head>
         <meta charset="utf-8">
         <meta name="viewport" content="width=device-width, initial-scale=1">
-
         <script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.7.0/jquery.min.js" integrity="sha512-3gJwYpMe3QewGELv8k/BX9vcqhryRdzRMxVfq6ngyWXwo03GFEzjsUm8Q7RZcHPHksttq7/GFoxjCVUjkjvPdw==" crossorigin="anonymous" referrerpolicy="no-referrer"></script>
         <link href="https://cdn.jsdelivr.net/npm/bootstrap@5.3.0/dist/css/bootstrap.min.css" rel="stylesheet" integrity="sha384-9ndCyUaIbzAi2FUVXJi0CjmCapSmO7SnpJef0486qhLnuZ2cdeRhO02iuK6FUUVM" crossorigin="anonymous">
 <script src="https://cdn.jsdelivr.net/npm/bootstrap@5.3.0/dist/js/bootstrap.bundle.min.js" integrity="sha384-geWF76RCwLtnZ8qwWowPQNguL3RmwHVBC9FhGdlKrxdiJJigb/j/68SIy3Te4Bkz" crossorigin="anonymous"></script>
@@ -128,11 +151,107 @@ htmlUi = do
         </script>
       </head>
       <body>
+        <form
+          hx-post="/snips/redacted/search"
+          hx-target="#redacted-search-results">
+          <label for="redacted-search">Redacted Search</label>
+          <input
+            id="redacted-search"
+            type="text"
+            name="redacted-search" />
+          <button type="submit">Search</button>
+        </form>
+        <div id="redacted-search-results"></div>
         {mkTable tableData bestTorrents}
       </body>
     |]
     snipsSong = todo
 
+snipsRedactedSearch ::
+  ( MonadLogger m,
+    MonadIO m,
+    MonadThrow m,
+    MonadPostgres m,
+    HasField "searchstr" r ByteString
+  ) =>
+  r ->
+  m Html
+snipsRedactedSearch dat = do
+  t <-
+    redactedSearchAndInsert
+      [ ("searchstr", dat.searchstr)
+      ]
+  best :: [TorrentData] <- runTransaction $ do
+    t
+    getBestTorrents
+  let bestRows =
+        best
+          & foldMap
+            ( \b -> do
+                [hsx|
+                  <tr>
+                  <td>{Html.toHtml @Int b.groupId}</td>
+                  <td>{Html.toHtml @Text b.torrentGroupJson.artist}</td>
+                  <td>{Html.toHtml @Text b.torrentGroupJson.groupName}</td>
+                  <td>{Html.toHtml @Int b.seedingWeight}</td>
+                  <td><details hx-post="snips/redacted/torrentDataJson" hx-vals={Enc.encToBytesUtf8 $ Enc.object [("torrent-id", Enc.int b.torrentIdDb)]}></details></td>
+                  </tr>
+                |]
+            )
+  pure $
+    [hsx|
+        <table class="table">
+          <thead>
+            <th>Group ID</th>
+            <th>Artist</th>
+            <th>Name</th>
+            <th>Weight</th>
+            <th>Torrent</th>
+            <th>Torrent Group</th>
+          </thead>
+          <tbody>
+            {bestRows}
+          </tbody>
+        </table>
+      |]
+
+mkVal :: Json.Value -> Html
+mkVal = \case
+  Json.Number n -> Html.toHtml @Text $ showToText n
+  Json.String s -> Html.toHtml @Text s
+  Json.Bool True -> [hsx|<em>true</em>|]
+  Json.Bool False -> [hsx|<em>false</em>|]
+  Json.Null -> [hsx|<em>null</em>|]
+  Json.Array arr ->
+    arr
+      & foldMap (\el -> Html.ul $ mkVal el)
+      & Html.ol
+  Json.Object obj ->
+    obj
+      & KeyMap.toMapText
+      & Map.toList
+      & foldMap (\(k, v) -> Html.dt (Html.toHtml @Text k <> Html.dd (mkVal v)))
+      & Html.dl
+
+toTable :: [[(Text, Json.Value)]] -> Html
+toTable xs =
+  case xs & nonEmpty of
+    Nothing ->
+      [hsx|<p>No results.</p>|]
+    Just xs' -> do
+      let headers = xs' & NonEmpty.head <&> fst <&> (\h -> [hsx|<th>{h}</th>|]) & mconcat
+      let vals = xs' <&> fmap (mkVal . snd)
+      [hsx|
+              <table class="table">
+                <thead>
+                  {headers}
+                </thead>
+                <tbody>
+                  {vals}
+                </tbody>
+              </table>
+          |]
+
 data TransmissionRequest = TransmissionRequest
   { method :: Text,
     arguments :: Map Text Enc,
@@ -140,6 +259,7 @@ data TransmissionRequest = TransmissionRequest
   }
   deriving stock (Show)
 
+testTransmission :: TransmissionRequest -> IO (Either TmpPg.StartError ())
 testTransmission req = runAppWith $ doTransmissionRequest (T2 (label @"host" "localhost") (label @"port" "9091")) req >>= liftIO . printPretty
 
 requestListAllTorrents :: TransmissionRequest
@@ -261,7 +381,7 @@ test doSearch =
 bla :: (MonadThrow m, MonadIO m, MonadLogger m, MonadPostgres m) => m (Transaction m ())
 bla = do
   t1 <-
-    realbla
+    redactedSearchAndInsert
       [ ("searchstr", "cherish"),
         ("artistname", "kirinji"),
         -- ("year", "1982"),
@@ -269,8 +389,17 @@ bla = do
         -- ("releasetype", "album"),
         ("order_by", "year")
       ]
+  t3 <-
+    redactedSearchAndInsert
+      [ ("searchstr", "mouss et hakim"),
+        ("artistname", "mouss et hakim"),
+        -- ("year", "1982"),
+        -- ("format", "MP3"),
+        -- ("releasetype", "album"),
+        ("order_by", "year")
+      ]
   t2 <-
-    realbla
+    redactedSearchAndInsert
       [ ("searchstr", "thriller"),
         ("artistname", "michael jackson"),
         -- ("year", "1982"),
@@ -278,82 +407,91 @@ bla = do
         -- ("releasetype", "album"),
         ("order_by", "year")
       ]
-  pure (t1 >> t2)
-  where
-    realbla x =
-      redactedSearch
-        x
-        ( do
-            status <- Json.key "status" Json.asText
-            when (status /= "success") $ do
-              Json.throwCustomError [fmt|Status was not "success", but {status}|]
-            Json.key "response" $ do
-              Json.key "results" $
-                sequence_
-                  <$> ( Json.eachInArray $ do
-                          groupId <- Json.key "groupId" (Json.asIntegral @_ @Int)
-                          groupName <- Json.key "groupName" Json.asText
-                          fullJsonResult <-
-                            Json.asObject
-                              -- remove torrents cause they are inserted separately below
-                              <&> KeyMap.filterWithKey (\k _ -> k /= "torrents")
-                              <&> Json.Object
-                          let insertTourGroup = do
-                                _ <-
-                                  execute
-                                    [fmt|
+  pure (t1 >> t2 >> t3)
+
+redactedSearchAndInsert ::
+  ( MonadLogger m1,
+    MonadIO m1,
+    MonadThrow m1,
+    MonadPostgres m2,
+    MonadThrow m2
+  ) =>
+  [(ByteString, ByteString)] ->
+  m1 (Transaction m2 ())
+redactedSearchAndInsert x =
+  redactedSearch
+    x
+    ( do
+        status <- Json.key "status" Json.asText
+        when (status /= "success") $ do
+          Json.throwCustomError [fmt|Status was not "success", but {status}|]
+        Json.key "response" $ do
+          Json.key "results" $
+            sequence_
+              <$> ( Json.eachInArray $ do
+                      groupId <- Json.key "groupId" (Json.asIntegral @_ @Int)
+                      groupName <- Json.key "groupName" Json.asText
+                      fullJsonResult <-
+                        Json.asObject
+                          -- remove torrents cause they are inserted separately below
+                          <&> KeyMap.filterWithKey (\k _ -> k /= "torrents")
+                          <&> Json.Object
+                      let insertTourGroup = do
+                            _ <-
+                              execute
+                                [fmt|
                                   DELETE FROM redacted.torrent_groups
                                   WHERE group_id = ?::integer
                               |]
-                                    (Only groupId)
-                                executeManyReturningWith
-                                  [fmt|
+                                (Only groupId)
+                            executeManyReturningWith
+                              [fmt|
                                 INSERT INTO redacted.torrent_groups (
                                   group_id, group_name, full_json_result
                                 ) VALUES
                                 ( ?, ? , ? )
                                 RETURNING (id)
                               |]
-                                  [ ( groupId,
-                                      groupName,
-                                      fullJsonResult
-                                    )
-                                  ]
-                                  (label @"tourGroupIdPg" <$> Dec.fromField @Int)
-                                  >>= ensureSingleRow
-                          insertTorrents <- Json.key "torrents" $ do
-                            torrents <- Json.eachInArray $ do
-                              torrentId <- Json.keyLabel @"torrentId" "torrentId" (Json.asIntegral @_ @Int)
-                              fullJsonResultT <- label @"fullJsonResult" <$> Json.asValue
-                              pure $ T2 torrentId fullJsonResultT
-                            pure $ \dat -> do
-                              _ <-
-                                execute
-                                  [sql|
+                              [ ( groupId,
+                                  groupName,
+                                  fullJsonResult
+                                )
+                              ]
+                              (label @"tourGroupIdPg" <$> Dec.fromField @Int)
+                              >>= ensureSingleRow
+                      insertTorrents <- Json.key "torrents" $ do
+                        torrents <- Json.eachInArray $ do
+                          torrentId <- Json.keyLabel @"torrentId" "torrentId" (Json.asIntegral @_ @Int)
+                          fullJsonResultT <- label @"fullJsonResult" <$> Json.asValue
+                          pure $ T2 torrentId fullJsonResultT
+                        pure $ \dat -> do
+                          _ <-
+                            execute
+                              [sql|
                                   DELETE FROM redacted.torrents_json
                                   WHERE torrent_id = ANY (?::integer[])
                             |]
-                                  (Only $ torrents & unzipT2 & (.torrentId) & PGArray)
-                              execute
-                                [sql|
+                              (Only $ torrents & unzipT2 & (.torrentId) & PGArray)
+                          execute
+                            [sql|
                                   INSERT INTO redacted.torrents_json
                                         (torrent_id, torrent_group, full_json_result)
                                   SELECT inputs.torrent_id, static.torrent_group, inputs.full_json_result FROM
                                   (SELECT * FROM UNNEST(?::integer[], ?::jsonb[])) AS inputs(torrent_id, full_json_result)
                                   CROSS JOIN (VALUES(?::integer)) as static(torrent_group)
                             |]
-                                ( torrents
-                                    & unzipT2
-                                    & \t ->
-                                      ( t.torrentId & PGArray,
-                                        t.fullJsonResult & PGArray,
-                                        dat.tourGroupIdPg
-                                      )
-                                )
-                              pure ()
-                          pure (insertTourGroup >>= insertTorrents)
-                      )
-        )
+                            ( torrents
+                                & unzipT2
+                                & \t ->
+                                  ( t.torrentId & PGArray,
+                                    t.fullJsonResult & PGArray,
+                                    dat.tourGroupIdPg
+                                  )
+                            )
+                          pure ()
+                      pure (insertTourGroup >>= insertTorrents)
+                  )
+    )
 
 migrate :: MonadPostgres m => Transaction m (Label "numberOfRowsAffected" Natural)
 migrate = do
@@ -398,11 +536,23 @@ migrate = do
 data TorrentData = TorrentData
   { groupId :: Int,
     torrentId :: Int,
+    torrentIdDb :: Int,
     seedingWeight :: Int,
     torrentJson :: Json.Value,
     torrentGroupJson :: T2 "artist" Text "groupName" Text
   }
 
+getTorrentById :: (MonadPostgres m, HasField "id" r Int, MonadThrow m) => r -> Transaction m Json.Value
+getTorrentById dat = do
+  queryWith
+    [sql|
+    SELECT full_json_result FROM redacted.torrents
+    WHERE id = ?::integer
+  |]
+    (getLabel @"id" dat)
+    (Dec.json Json.asValue)
+    >>= ensureSingleRow
+
 -- | Find the best torrent for each torrent group (based on the seeding_weight)
 getBestTorrents :: MonadPostgres m => Transaction m [TorrentData]
 getBestTorrents = do
@@ -411,6 +561,7 @@ getBestTorrents = do
       SELECT * FROM (
         SELECT DISTINCT ON (group_id)
           tg.group_id,
+          t.id,
           t.torrent_id,
           seeding_weight,
           t.full_json_result AS torrent_json,
@@ -424,6 +575,7 @@ getBestTorrents = do
     ()
     ( do
         groupId <- Dec.fromField @Int
+        torrentIdDb <- Dec.fromField @Int
         torrentId <- Dec.fromField @Int
         seedingWeight <- Dec.fromField @Int
         torrentJson <- Dec.json Json.asValue
diff --git a/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal b/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal
index 58aebe943c..8b9dcee422 100644
--- a/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal
+++ b/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal
@@ -62,6 +62,7 @@ library
        Postgres.MonadPostgres
        Tool
        ValidationParseT
+       Multipart2
 
     build-depends:
         base >=4.15 && <5,
@@ -90,6 +91,10 @@ library
         unix,
         warp,
         wai,
+        wai-extra,
         ihp-hsx,
         blaze-html,
+        bytestring,
+        dlist,
+        selective