diff options
Diffstat (limited to 'users/Profpatsch/whatcd-resolver/src')
| -rw-r--r-- | users/Profpatsch/whatcd-resolver/src/AppT.hs | 10 | ||||
| -rw-r--r-- | users/Profpatsch/whatcd-resolver/src/Redacted.hs | 24 | ||||
| -rw-r--r-- | users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs | 27 |
3 files changed, 45 insertions, 16 deletions
diff --git a/users/Profpatsch/whatcd-resolver/src/AppT.hs b/users/Profpatsch/whatcd-resolver/src/AppT.hs index 397ea5c33b2f..6a8637bb1660 100644 --- a/users/Profpatsch/whatcd-resolver/src/AppT.hs +++ b/users/Profpatsch/whatcd-resolver/src/AppT.hs @@ -74,6 +74,16 @@ addAttribute span key a = Otel.addAttribute span ("_." <> key) a addAttributes :: (MonadIO m) => Otel.Span -> HashMap Text Otel.Attribute -> m () addAttributes span attrs = Otel.addAttributes span $ attrs & HashMap.mapKeys ("_." <>) +addEventSimple :: (MonadIO m) => Otel.Span -> Text -> m () +addEventSimple span name = + Otel.addEvent + span + Otel.NewEvent + { Otel.newEventName = name, + Otel.newEventTimestamp = Nothing, + Otel.newEventAttributes = mempty + } + -- | Create an otel attribute from a json encoder jsonAttribute :: Enc -> Otel.Attribute jsonAttribute e = e & Enc.encToTextPretty & Otel.toAttribute diff --git a/users/Profpatsch/whatcd-resolver/src/Redacted.hs b/users/Profpatsch/whatcd-resolver/src/Redacted.hs index 6cdb22273fad..5b6751346b18 100644 --- a/users/Profpatsch/whatcd-resolver/src/Redacted.hs +++ b/users/Profpatsch/whatcd-resolver/src/Redacted.hs @@ -364,14 +364,13 @@ data TorrentData transmissionInfo = TorrentData torrentId :: Int, seedingWeight :: Int, artists :: [T2 "artistId" Int "artistName" Text], - torrentJson :: Json.Value, torrentGroupJson :: TorrentGroupJson, torrentStatus :: TorrentStatus transmissionInfo } data TorrentGroupJson = TorrentGroupJson { groupName :: Text, - groupYear :: Int + groupYear :: Natural } data TorrentStatus transmissionInfo @@ -420,8 +419,9 @@ getBestTorrents opts = do tg.group_id, t.torrent_id, t.seeding_weight, - t.full_json_result AS torrent_json, - tg.full_json_result AS torrent_group_json, + t.full_json_result->'artists' 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, t.transmission_torrent_hash FROM filtered_torrents f @@ -442,19 +442,15 @@ getBestTorrents opts = do groupId <- Dec.fromField @Int torrentId <- Dec.fromField @Int seedingWeight <- Dec.fromField @Int - (torrentJson, artists) <- Dec.json $ do - val <- Json.asValue - artists <- Json.keyOrDefault "artists" [] $ Json.eachInArray $ do + artists <- Dec.json $ + Json.eachInArray $ do id_ <- Json.keyLabel @"artistId" "id" (Json.asIntegral @_ @Int) name <- Json.keyLabel @"artistName" "name" Json.asText pure $ T2 id_ name - pure (val, artists) - torrentGroupJson <- - ( Dec.json $ do - groupName <- Json.key "groupName" Json.asText - groupYear <- Json.key "groupYear" (Json.asIntegral @_ @Int) - pure $ TorrentGroupJson {..} - ) + torrentGroupJson <- do + groupName <- Dec.text + groupYear <- Dec.textParse Field.decimalNatural + pure $ TorrentGroupJson {..} hasTorrentFile <- Dec.fromField @Bool transmissionTorrentHash <- Dec.fromField @(Maybe Text) diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs index 169d3b82aa46..ad363090ffdd 100644 --- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs +++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs @@ -388,6 +388,7 @@ runHandlers defaultHandler handlers req respond = withRunInIO $ \runInIO -> do ) ( \span -> do res <- act span <&> (\h -> T2 (label @"html" h) (label @"extraHeaders" [])) + 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 @@ -444,6 +445,24 @@ singleQueryArgument field inner = ) >>> Parse.fieldParser inner +singleQueryArgumentMay :: Text -> FieldParser ByteString to -> Parse Http.Query (Maybe to) +singleQueryArgumentMay field inner = + Parse.mkParsePushContext + field + ( \(ctx, qry) -> case qry + & mapMaybe + ( \(k, v) -> + if k == (field & textToBytesUtf8) + then Just v + else Nothing + ) of + [] -> Right Nothing + [Nothing] -> Left [fmt|Expected one query argument with a value, but "{field}" was a query flag|] + [Just one] -> Right (Just one) + more -> Left [fmt|More than one value for query argument "{field}": {show more}, at {ctx & Parse.showContext}|] + ) + >>> Parse.maybe (Parse.fieldParser inner) + -- | Make sure we can parse the given Text into an URI. textToURI :: Parse Text URI textToURI = @@ -518,6 +537,9 @@ getBestTorrentsTable dat = do fresh <- getBestTorrentsData dat pure $ mkBestTorrentsTable fresh +doIfJust :: (Applicative f) => (a -> f ()) -> Maybe a -> f () +doIfJust = traverse_ + getBestTorrentsData :: ( MonadTransmission m, MonadThrow m, @@ -527,7 +549,8 @@ getBestTorrentsData :: ) => Maybe (Label "artistRedactedId" Natural) -> Transaction m [TorrentData (Label "percentDone" Percentage)] -getBestTorrentsData artistFilter = do +getBestTorrentsData artistFilter = inSpan' "get torrents table data" $ \span -> do + artistFilter & doIfJust (\a -> addAttribute span "artist-filter.redacted-id" (a.artistRedactedId & showToText & Otel.toAttribute)) bestStale :: [TorrentData ()] <- getBestTorrents GetBestTorrentsFilter {onlyArtist = artistFilter, onlyDownloaded = False} actual <- getAndUpdateTransmissionTorrentsStatus @@ -596,7 +619,7 @@ mkBestTorrentsTable fresh = do {Html.toHtml @Text b.torrentGroupJson.groupName} </a> </td> - <td>{Html.toHtml @Int b.torrentGroupJson.groupYear}</td> + <td>{Html.toHtml @Natural b.torrentGroupJson.groupYear}</td> <td>{Html.toHtml @Int b.seedingWeight}</td> <td><details hx-trigger="toggle once" hx-post="snips/redacted/torrentDataJson" hx-vals={Enc.encToBytesUtf8 $ Enc.object [("torrent-id", Enc.int b.torrentId)]}></details></td> </tr> |