fix(users/Profpatsch/whatcd-resolver): handle weird search results

Apparently they added the ability to add random files (e.g. pdfs), and
the API returns undocumented objects if that happens.

Let’s skip these.

Change-Id: Icd783a6ed2114520e5c524f2a2c3acfcb67d792e
Reviewed-on: https://cl.tvl.fyi/c/depot/+/12954
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2025-01-04 23:30:23 +01:00
parent 428f574b75
commit a14a7e6ec9

View file

@ -12,6 +12,7 @@ import Data.Aeson.BetterErrors qualified as Json
import Data.Aeson.KeyMap qualified as KeyMap import Data.Aeson.KeyMap qualified as KeyMap
import Data.Error.Tree import Data.Error.Tree
import Data.List qualified as List import Data.List qualified as List
import Data.Maybe (catMaybes)
import Database.PostgreSQL.Simple (Binary (Binary), Only (..)) import Database.PostgreSQL.Simple (Binary (Binary), Only (..))
import Database.PostgreSQL.Simple.Types (PGArray (PGArray)) import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
import FieldParser qualified as Field import FieldParser qualified as Field
@ -152,23 +153,29 @@ redactedSearchAndInsert extraArguments = do
Json.key "results" $ do Json.key "results" $ do
tourGroups <- tourGroups <-
label @"tourGroups" label @"tourGroups"
<$> ( Json.eachInArray $ do <$> ( catMaybes
groupId <- Json.keyLabel @"groupId" "groupId" (Json.asIntegral @_ @Int) <$> ( Json.eachInArray $ do
groupName <- Json.keyLabel @"groupName" "groupName" Json.asText Json.keyMay "torrents" (pure ()) >>= \case
fullJsonResult <- -- not a torrent group, maybe some files or something (e.g. guitar tabs see Dream Theater Systematic Chaos)
label @"fullJsonResult" Nothing -> pure Nothing
<$> ( Json.asObject Just () -> do
-- remove torrents cause they are inserted separately below groupId <- Json.keyLabel @"groupId" "groupId" (Json.asIntegral @_ @Int)
<&> KeyMap.filterWithKey (\k _ -> k /= "torrents") groupName <- Json.keyLabel @"groupName" "groupName" Json.asText
<&> Json.Object fullJsonResult <-
) label @"fullJsonResult"
let tourGroup = T3 groupId groupName fullJsonResult <$> ( Json.asObject
torrents <- Json.keyLabel @"torrents" "torrents" $ -- remove torrents cause they are inserted separately below
Json.eachInArray $ do <&> KeyMap.filterWithKey (\k _ -> k /= "torrents")
torrentId <- Json.keyLabel @"torrentId" "torrentId" (Json.asIntegral @_ @Int) <&> Json.Object
fullJsonResultT <- label @"fullJsonResult" <$> Json.asValue )
pure $ T2 torrentId fullJsonResultT let tourGroup = T3 groupId groupName fullJsonResult
pure (T2 (label @"tourGroup" tourGroup) torrents) 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 pure
( T2 ( T2
@ -580,3 +587,13 @@ redactedApiRequestJson span dat parser = do
addAttribute span "redacted.request" (toOtelJsonAttr (T2 (getLabel @"action" dat) (getLabel @"actionArgs" dat))) addAttribute span "redacted.request" (toOtelJsonAttr (T2 (getLabel @"action" dat) (getLabel @"actionArgs" dat)))
mkRedactedApiRequest dat mkRedactedApiRequest dat
>>= Http.httpJson defaults parser >>= 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