feat(users/Profpatsch/whatcd-resolver): trace http requests r/7766

Move the http calls into their own module, so we can trace the request
and provide a simple copy-to-replay command.

We have to work around a bug in the otel library, which would limit
our attribute value length to 128 bytes because it uses the wrong
option value.

~~~

`ifExists` is finally made more useful for dealing with optional
attributes in e.g. lists.

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

1 files changed, 5 insertions, 17 deletions

diff --git a/users/Profpatsch/whatcd-resolver/src/Redacted.hs b/users/Profpatsch/whatcd-resolver/src/Redacted.hs
index 573dd75877bf..4369c184087a 100644
--- a/users/Profpatsch/whatcd-resolver/src/Redacted.hs
+++ b/users/Profpatsch/whatcd-resolver/src/Redacted.hs
@@ -14,7 +14,6 @@ import Database.PostgreSQL.Simple (Binary (Binary), Only (..))
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
 import FieldParser qualified as Field
-import GHC.Records (HasField (..))
 import Json qualified
 import Label
 import MyPrelude
@@ -23,6 +22,7 @@ import Network.HTTP.Simple qualified as Http
 import Network.HTTP.Types
 import Network.Wai.Parse qualified as Wai
 import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan')
+import Optional
 import Postgres.Decoder qualified as Dec
 import Postgres.MonadPostgres
 import Pretty
@@ -134,7 +134,7 @@ redactedSearchAndInsert extraArguments = do
       redactedSearch
         ( extraArguments
             -- pass the page (for every search but the first one)
-            <> ifExists (mpage <&> (\page -> [("page", (page :: Natural) & showToText & textToBytesUtf8)]))
+            <> (mpage & ifExists (\page -> ("page", (page :: Natural) & showToText & textToBytesUtf8)))
         )
         ( do
             status <- Json.key "status" Json.asText
@@ -361,7 +361,7 @@ data TorrentData transmissionInfo = TorrentData
     torrentId :: Int,
     seedingWeight :: Int,
     torrentJson :: Json.Value,
-    torrentGroupJson :: T2 "artist" Text "groupName" Text,
+    torrentGroupJson :: T3 "artist" Text "groupName" Text "groupYear" Int,
     torrentStatus :: TorrentStatus transmissionInfo
   }
 
@@ -411,7 +411,8 @@ getBestTorrents = do
           ( Dec.json $ do
               artist <- Json.keyLabel @"artist" "artist" Json.asText
               groupName <- Json.keyLabel @"groupName" "groupName" Json.asText
-              pure $ T2 artist groupName
+              groupYear <- Json.keyLabel @"groupYear" "groupYear" (Json.asIntegral @_ @Int)
+              pure $ T3 artist groupName groupYear
             )
         hasTorrentFile <- Dec.fromField @Bool
         transmissionTorrentHash <-
@@ -479,19 +480,6 @@ httpTorrent span req =
             | code <- statusCode -> Left [fmt|Redacted returned an non-200 error code, code {code}: {resp & showPretty}|]
       )
 
-newtype Optional a = OptionalInternal (Maybe a)
-
-mkOptional :: a -> Optional a
-mkOptional defaultValue = OptionalInternal $ Just defaultValue
-
-defaults :: Optional a
-defaults = OptionalInternal Nothing
-
-instance HasField "withDefault" (Optional a) (a -> a) where
-  getField (OptionalInternal m) defaultValue = case m of
-    Nothing -> defaultValue
-    Just a -> a
-
 httpJson ::
   ( MonadThrow m,
     MonadOtel m