lrclib-client 0.2.2 → 0.2.3

raw patch · 3 files changed

+118/−93 lines, 3 filesdep +http-clientdep +http-client-tlsdep +http-typesdep −lensdep −wreqdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-client, http-client-tls, http-types

Dependencies removed: lens, wreq

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• lrclib-client.cabal +8/−8
• src/LrcLib/Client.hs +101/−71
• src/LrcLib/Types.hs +9/−14

@@ -1,7 +1,7 @@ cabal-version:      3.0  name:               lrclib-client-version:            0.2.2+version:            0.2.3 synopsis:           A Haskell client for the LrcLib API (lyrics database) description:   This library provides types and functions to interact with the@@ -29,22 +29,22 @@   import:           warnings   exposed-modules:  LrcLib.Client, LrcLib.Types   build-depends:    aeson >= 2.2.3 && < 2.3,-                    base >= 4.18 && < 4.21,+                    base >= 4.19 && < 4.21,                     base16-bytestring >= 1.0.2 && < 1.1,                     bytestring >= 0.12.2 && < 0.13,                     cryptohash-sha256 >= 0.11.102 && < 0.12,-                    lens >= 5.3.5 && < 5.4,+                    http-client >= 0.7.19 && < 0.8,+                    http-client-tls >= 0.3.6 && < 0.4,+                    http-types >= 0.12.4 && < 0.13,                     mtl >= 2.3.1 && < 2.4,                     text >= 2.1.3 && < 2.2,-                    wreq >= 0.5.4 && < 0.6,-   hs-source-dirs:   src-  default-language: GHC2021+  default-language: GHC2024  test-suite test-  import: warnings+  import:           warnings   type:             exitcode-stdio-1.0   hs-source-dirs:   test   main-is:          Main.hs   build-depends:    aeson, base, bytestring, tasty, tasty-hunit, lrclib-client-  default-language: GHC2021+  default-language: GHC2024

@@ -1,24 +1,23 @@-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  -- | Module for calling LRCLIB API (<https://lrclib.net/docs>) module LrcLib.Client   ( module LrcLib.Types,+    runAPI,+    runDefaultAPI,     getLyrics,     getCachedLyrics,     getLyricsById,-    requestChallenge,     searchLyrics,     publish',-    solveChallenge,     publish,-    runAPI,-    runDefaultAPI,+    requestChallenge,+    solveChallenge,   ) where -import Control.Lens ((&), (&~), (.=), (.~), (^.)) import Control.Monad.IO.Class (liftIO) import Control.Monad.Reader (ask, runReaderT) import Crypto.Hash.SHA256 (hash)@@ -27,13 +26,21 @@ import Data.ByteString.Char8 qualified as BC import Data.ByteString.Lazy (ByteString) import Data.Either (fromRight)-import Data.Foldable (toList) import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding (encodeUtf8) import GHC.Stack import LrcLib.Types-import Network.Wreq+import Network.HTTP.Client+  ( Request (method, path, queryString, requestBody, requestHeaders),+    RequestBody (RequestBodyLBS),+    Response (responseBody, responseStatus),+    httpLbs,+    httpNoBody,+    parseRequest_,+  )+import Network.HTTP.Client.TLS (getGlobalManager)+import Network.HTTP.Types (Status (statusCode), renderSimpleQuery) import Prelude hiding (id)  decode :: (A.FromJSON a, HasCallStack) => ByteString -> a@@ -42,64 +49,71 @@   Right y -> y  -- | Run API action with given API url-runAPI :: Url -> API a -> IO a+runAPI :: Request -> API a -> IO a runAPI url f = runReaderT f url  -- | Run API action ('runAPI') with default API url -- -- >>> runDefaultAPI $ getLyricsById 1337--- OK Track, id: 1337, name: Speak Français, artist: Ellis feat. NOËP, album: Speak Français+-- Right Track, id: 1337, name: Speak Français, artist: Ellis feat. NOËP, album: Speak Français runDefaultAPI :: API a -> IO a-runDefaultAPI = runAPI "http://lrclib.net/api"+runDefaultAPI = runAPI $ parseRequest_ "https://lrclib.net/api" -getUrl :: String -> Text -> Text -> Text -> Integer -> API GetResponse-getUrl url track artist album duration = do-  apiUrl <- ask-  resp <- liftIO $ getWith opts $ apiUrl <> url-  case resp ^. responseStatus . statusCode of-    404 -> pure NotFound-    200 -> pure $ OK $ decode (resp ^. responseBody)+get' :: String -> Text -> Text -> Text -> Integer -> API (Either GetError TrackData)+get' subpath track artist album duration = do+  api <- ask+  let req =+        api+          { path = api.path <> BC.pack subpath,+            queryString =+              renderSimpleQuery+                False+                [ ("track_name", encodeUtf8 track),+                  ("artist_name", encodeUtf8 artist),+                  ("album_name", encodeUtf8 album),+                  ("duration", BC.pack $ show duration)+                ]+          }+  man <- liftIO getGlobalManager+  resp <- liftIO $ httpLbs req man+  case resp.responseStatus.statusCode of+    404 -> pure $ Left NotFound+    200 -> pure $ Right $ decode resp.responseBody     s -> error $ "Unexpected status code on get endpoint: " <> show s-  where-    opts =-      defaults &~ do-        checkResponse .= (Just $ \_ _ -> pure ())-        param "track_name" .= [track]-        param "artist_name" .= [artist]-        param "album_name" .= [album]-        param "duration" .= [T.pack $ show duration] -getLyrics, getCachedLyrics :: Text -> Text -> Text -> Integer -> API GetResponse+getLyrics,+  getCachedLyrics ::+    Text -> Text -> Text -> Integer -> API (Either GetError TrackData)  -- | Get lyrics by track name, artist, album and duration -- Calls @\/api\/get@ -- -- >>> runDefaultAPI $ getLyrics "ThisTrackDoesntExist" "UnknownArtist" "UnknownAlbum" 1337--- NotFound+-- Left NotFound -- -- >>> runDefaultAPI $ getLyrics "Speak Français" "Ellis feat. NOËP" "Speak Français" 201--- OK Track, id: 1337, name: Speak Français, artist: Ellis feat. NOËP, album: Speak Français-getLyrics = getUrl "/get"+-- Right Track, id: 1337, name: Speak Français, artist: Ellis feat. NOËP, album: Speak Français+getLyrics = get' "/get"  -- | The same as 'getLyrics', but for cached lyrics. -- Calls @\/api\/get-cached@-getCachedLyrics = getUrl "/get-cached"+getCachedLyrics = get' "/get-cached"  -- | Get lyrics by id -- Calls @\/api\/get\/\<id\>@ -- -- >>> runDefaultAPI $ getLyricsById 1337--- OK Track, id: 1337, name: Speak Français, artist: Ellis feat. NOËP, album: Speak Français-getLyricsById :: Integer -> API GetResponse-getLyricsById id' = do-  url <- ask-  resp <- liftIO $ getWith opts $ url <> "/get/" <> show id'-  case resp ^. responseStatus . statusCode of-    404 -> pure NotFound-    200 -> pure $ OK $ decode (resp ^. responseBody)+-- Right Track, id: 1337, name: Speak Français, artist: Ellis feat. NOËP, album: Speak Français+getLyricsById :: (HasCallStack) => Integer -> API (Either GetError TrackData)+getLyricsById id = do+  api <- ask+  let req = api {path = api.path <> "/get/" <> BC.pack (show id)}+  man <- liftIO getGlobalManager+  resp <- liftIO $ httpLbs req man+  case resp.responseStatus.statusCode of+    404 -> pure $ Left NotFound+    200 -> pure $ Right $ decode resp.responseBody     _ -> error "Unexpected status code on get endpoint"-  where-    opts = defaults &~ checkResponse .= (Just $ \_ _ -> pure ())  -- | Search lyrics by either text query or track-artist-album -- Calls @\/api\/search@@@ -108,31 +122,45 @@ -- Track, id: 1337, name: Speak Français, artist: Ellis feat. NOËP, album: Speak Français searchLyrics :: SearchQuery -> API SearchResponse searchLyrics q = do-  url <- ask-  resp <- liftIO $ getWith opts $ url <> "/search"-  pure $ decode (resp ^. responseBody)-  where-    opts =-      defaults &~ case q of-        TextQuery t -> param "q" .= [t]-        TrackQuery {..} -> do-          param "track_name" .= [queryName]-          param "artist_name" .= toList queryArtist-          param "album_name" .= toList queryAlbum+  api <- ask+  let req =+        api+          { path = api.path <> "/search",+            queryString = renderSimpleQuery False $+              case q of+                TextQuery t -> [("q", encodeUtf8 t)]+                TrackQuery {..} ->+                  [("track_name", encodeUtf8 queryName)]+                    ++ [ ("artist_name", encodeUtf8 artist)+                       | Just artist <- pure queryArtist+                       ]+                    ++ [ ("album_name", encodeUtf8 album)+                       | Just album <- pure queryAlbum+                       ]+          }+  man <- liftIO getGlobalManager+  resp <- liftIO $ httpLbs req man+  pure $ decode resp.responseBody  -- | Publish Lyrics ('publish') without requesting and solving challenge -- Calls @\/api\/publish@-publish' :: PublishToken -> PublishRequest -> API PublishResponse+publish' :: (HasCallStack) => PublishToken -> PublishRequest -> API (Either PublishError ()) publish' token request = do-  url <- ask-  res <- liftIO $ postWith opts (url <> "/publish") body-  case res ^. responseStatus . statusCode of-    400 -> pure IncorrectToken-    201 -> pure PublishOK+  api <- ask+  let req =+        api+          { method = "POST",+            path = api.path <> "/publish",+            requestHeaders =+              api.requestHeaders <> [("X-Publish-Token", encodeUtf8 token)],+            requestBody = RequestBodyLBS $ A.encode request+          }+  man <- liftIO getGlobalManager+  res <- liftIO $ httpNoBody req man+  case res.responseStatus.statusCode of+    400 -> pure $ Left IncorrectToken+    201 -> pure $ Right ()     s -> error $ "Unexpected status code on publish endpoint: " <> show s-  where-    body = A.toJSON request-    opts = defaults & header "X-Publish-Token" .~ [encodeUtf8 token]  -- | Request proof-of-work challenge for publish -- Calls @\/api\/request-challenge@@@ -141,16 +169,11 @@ -- Challenge {prefix = "BVNC...XoVu1H", target = "000000FF0...00000"} requestChallenge :: API Challenge requestChallenge = do-  url <- ask-  resp <- liftIO $ post (url <> "/request-challenge") $ A.toJSON ()-  pure $ decode (resp ^. responseBody)---- | Publish Lyrics (request and solve challenge)--- Calls @\/api\/publish@-publish :: PublishRequest -> API PublishResponse-publish r = do-  c <- requestChallenge-  publish' (solveChallenge c) r+  api <- ask+  let req = api {method = "POST", path = api.path <> "/request-challenge"}+  man <- liftIO getGlobalManager+  resp <- liftIO $ httpLbs req man+  pure $ decode resp.responseBody  -- | Solve proof-of-work challenge for publish -- Solution is a one-time publish token@@ -162,3 +185,10 @@     go :: Int -> Text     go n | hash (prefix' <> BC.pack (show n)) < target' = prefix <> ":" <> T.show n     go n = go (n + 1)++-- | Publish Lyrics (request and solve challenge)+-- Calls @\/api\/publish@+publish :: (HasCallStack) => PublishRequest -> API (Either PublishError ())+publish r = do+  c <- requestChallenge+  publish' (solveChallenge c) r

@@ -6,14 +6,13 @@  module LrcLib.Types   ( API,-    Url,     SearchResponse,     Challenge (..),-    GetResponse (..),+    GetError (..),     TrackData (..),     SearchQuery (..),+    PublishError (..),     PublishToken,-    PublishResponse (..),     PublishRequest (..),   ) where@@ -23,12 +22,10 @@ import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic)---- | Representation of API url-type Url = String+import Network.HTTP.Client (Request) --- | Monad for API actions that includes API url-type API = ReaderT Url IO+-- | Monad for API actions that includes API url (as a base request)+type API = ReaderT Request IO  -- | Crypto proof-of-work challenge for publish data Challenge@@ -52,10 +49,8 @@   }   deriving (A.FromJSON, Generic, Eq, Read) --- | Response when getting lyrics-data GetResponse-  = NotFound-  | OK TrackData+-- | Error when getting lyrics+data GetError = NotFound   deriving (Generic, A.FromJSON, Show)  type PublishToken = Text@@ -72,8 +67,8 @@   }   deriving (Generic, A.ToJSON) --- | Response when publishing lyrics-data PublishResponse = PublishOK | IncorrectToken+-- | Error when publishing lyrics+data PublishError = IncorrectToken  -- | Query for search. Either text or track+artist+album data SearchQuery