corpus

self-hosted listenbrainz and last.fm proxy
Log | Files | Refs | README | LICENSE

Cosine.purs (5410B)

      1 module Cosine
      2   ( fetchCosineSimilar
      3   , serveSimilar
      4   ) where
      5 
      6 import Prelude
      7 
      8 import Config (UserConfig)
      9 import Control.Monad.Error.Class (throwError)
     10 import Data.Array ((!!))
     11 import Data.Either (Either(..), hush)
     12 import Data.Argonaut (parseJson)
     13 import Data.Argonaut.Core (toArray, toObject, toString)
     14 import Data.Maybe (Maybe(..), fromMaybe)
     15 import Effect (Effect)
     16 import Effect.Aff (Aff, launchAff_, try)
     17 import Effect.Class (liftEffect)
     18 import Effect.Exception as Exception
     19 import Fetch (fetch, Method(GET))
     20 import Foreign.Object as Object
     21 import JSURI (encodeURIComponent)
     22 import Log as Log
     23 import Metrics as Metrics
     24 import Node.Encoding (Encoding(UTF8))
     25 import Node.HTTP.OutgoingMessage (setHeader, toWriteable)
     26 import Node.HTTP.ServerResponse (setStatusCode, toOutgoingMessage)
     27 import Node.HTTP.Types (ServerResponse)
     28 import Node.Stream (end, writeString)
     29 import Web.URL (URL)
     30 import Web.URL.URLSearchParams as URLSearchParams
     31 import Web.URL as URL
     32 
     33 type Response = ServerResponse
     34 
     35 getQueryParam :: String -> URL -> Maybe String
     36 getQueryParam key url = URLSearchParams.get key (URL.searchParams url)
     37 
     38 fetchCosineSimilar :: String -> UserConfig -> String -> Aff String
     39 fetchCosineSimilar slug cfg query = do
     40   let apiKey = fromMaybe "" cfg.cosineApiKey
     41   if apiKey == "" then do
     42     Log.warn "cosineApiKey not configured for similar tracks"
     43     liftEffect $ Metrics.incCosineRequest slug "not_configured"
     44     pure "{\"data\":{\"similar_tracks\":[]},\"success\":true}"
     45   else do
     46     let headers = { "User-Agent": "corpus/1.0 +https://sr.ht/~mtmn/corpus", "Authorization": "Bearer " <> apiKey }
     47     let searchUrl = "https://cosine.club/api/v1/search?q=" <> (fromMaybe "" $ encodeURIComponent query) <> "&limit=1"
     48     Log.info $ "Cosine Club: searching for: " <> query
     49     searchResult <- try $ fetch searchUrl { method: GET, headers: headers }
     50     case searchResult of
     51       Left err -> do
     52         liftEffect $ Metrics.incCosineRequest slug "error"
     53         throwError err
     54       Right searchRes ->
     55         if searchRes.status == 429 then do
     56           Log.warn "Cosine Club: rate limited on search"
     57           liftEffect $ Metrics.incCosineRequest slug "rate_limited"
     58           throwError (Exception.error "Rate limit exceeded")
     59         else if searchRes.status /= 200 then do
     60           Log.warn $ "Cosine Club: search returned " <> show searchRes.status
     61           liftEffect $ Metrics.incCosineRequest slug "error"
     62           throwError (Exception.error "Search API error")
     63         else do
     64           searchBody <- searchRes.text
     65           let
     66             mTrackId = do
     67               json <- hush $ parseJson searchBody
     68               obj <- toObject json
     69               arr <- Object.lookup "data" obj >>= toArray
     70               first <- arr !! 0
     71               firstObj <- toObject first
     72               Object.lookup "id" firstObj >>= toString
     73           case mTrackId of
     74             Nothing -> do
     75               Log.info $ "Cosine Club: track not indexed: " <> query
     76               liftEffect $ Metrics.incCosineRequest slug "not_indexed"
     77               pure "{\"data\":{\"similar_tracks\":[]},\"success\":true}"
     78             Just trackId -> do
     79               let similarUrl = "https://cosine.club/api/v1/tracks/" <> trackId <> "/similar?limit=10"
     80               Log.info $ "Cosine Club: fetching similar for ID " <> trackId
     81               similarResult <- try $ fetch similarUrl { method: GET, headers: headers }
     82               case similarResult of
     83                 Left err -> do
     84                   liftEffect $ Metrics.incCosineRequest slug "error"
     85                   throwError err
     86                 Right similarRes ->
     87                   if similarRes.status == 429 then do
     88                     Log.warn "Cosine Club: rate limited on similar"
     89                     liftEffect $ Metrics.incCosineRequest slug "rate_limited"
     90                     throwError (Exception.error "Rate limit exceeded")
     91                   else if similarRes.status /= 200 then do
     92                     Log.warn $ "Cosine Club: similar API returned " <> show similarRes.status
     93                     liftEffect $ Metrics.incCosineRequest slug "error"
     94                     throwError (Exception.error "Similar API error")
     95                   else do
     96                     liftEffect $ Metrics.incCosineRequest slug "success"
     97                     similarRes.text
     98 
     99 serveSimilar
    100   :: (Response -> String -> Effect Unit)
    101   -> (Response -> Int -> String -> String -> Effect Unit)
    102   -> String
    103   -> UserConfig
    104   -> URL
    105   -> Response
    106   -> Effect Unit
    107 serveSimilar serveBadRequest serveError slug cfg url res = do
    108   setHeader "Content-Type" "application/json" (toOutgoingMessage res)
    109   launchAff_ do
    110     let artist = fromMaybe "" (getQueryParam "artist" url)
    111     let track = fromMaybe "" (getQueryParam "track" url)
    112     if artist == "" || track == "" then
    113       liftEffect $ serveBadRequest res "Artist and track parameters are required"
    114     else do
    115       let query = artist <> " - " <> track
    116       result <- try $ fetchCosineSimilar slug cfg query
    117       case result of
    118         Left err -> do
    119           Log.error $ "Cosine Club API error: " <> Exception.message err
    120           liftEffect $ serveError res 502 "Bad Gateway" "Failed to fetch similar tracks"
    121         Right responseBody ->
    122           liftEffect $ do
    123             setStatusCode 200 res
    124             let w = toWriteable (toOutgoingMessage res)
    125             void $ writeString w UTF8 responseBody
    126             end w