lrclib-client 0.2.3 → 0.3.0
raw patch · 3 files changed
+84/−65 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- lrclib-client.cabal +2/−1
- src/LrcLib/Client.hs +30/−64
- src/LrcLib/HTTP.hs +52/−0
lrclib-client.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: lrclib-client-version: 0.2.3+version: 0.3.0 synopsis: A Haskell client for the LrcLib API (lyrics database) description: This library provides types and functions to interact with the@@ -28,6 +28,7 @@ library import: warnings exposed-modules: LrcLib.Client, LrcLib.Types+ other-modules: LrcLib.HTTP build-depends: aeson >= 2.2.3 && < 2.3, base >= 4.19 && < 4.21, base16-bytestring >= 1.0.2 && < 1.1,
src/LrcLib/Client.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BlockArguments #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -18,32 +19,28 @@ ) where -import Control.Monad.IO.Class (liftIO)-import Control.Monad.Reader (ask, runReaderT)+import Control.Monad.Reader (runReaderT) import Crypto.Hash.SHA256 (hash) import Data.Aeson qualified as A+import Data.ByteString (ByteString) import Data.ByteString.Base16 qualified as B16 import Data.ByteString.Char8 qualified as BC-import Data.ByteString.Lazy (ByteString) import Data.Either (fromRight) import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding (encodeUtf8) import GHC.Stack+import LrcLib.HTTP as HTTP import LrcLib.Types import Network.HTTP.Client- ( Request (method, path, queryString, requestBody, requestHeaders),- RequestBody (RequestBodyLBS),+ ( Request, Response (responseBody, responseStatus),- httpLbs,- httpNoBody, parseRequest_, )-import Network.HTTP.Client.TLS (getGlobalManager)-import Network.HTTP.Types (Status (statusCode), renderSimpleQuery)+import Network.HTTP.Types (Status (statusCode)) import Prelude hiding (id) -decode :: (A.FromJSON a, HasCallStack) => ByteString -> a+decode :: (A.FromJSON a, HasCallStack) => ByteStringL -> a decode x = case A.eitherDecode x of Left err -> error $ "Error while decoding JSON: " <> err Right y -> y@@ -59,27 +56,20 @@ runDefaultAPI :: API a -> IO a runDefaultAPI = runAPI $ parseRequest_ "https://lrclib.net/api" -get' :: String -> Text -> Text -> Text -> Integer -> API (Either GetError TrackData)+get' :: ByteString -> 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+ resp <- HTTP.get subpath query 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+ query =+ [ ("track_name", track),+ ("artist_name", artist),+ ("album_name", album),+ ("duration", T.show duration)+ ] getLyrics, getCachedLyrics ::@@ -106,10 +96,7 @@ -- 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+ resp <- HTTP.get ("/get/" <> BC.pack (show id)) [] case resp.responseStatus.statusCode of 404 -> pure $ Left NotFound 200 -> pure $ Right $ decode resp.responseBody@@ -122,42 +109,24 @@ -- Track, id: 1337, name: Speak Français, artist: Ellis feat. NOËP, album: Speak Français searchLyrics :: SearchQuery -> API SearchResponse searchLyrics q = do- 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+ resp <- HTTP.get "/search" query pure $ decode resp.responseBody+ where+ query = case q of+ TextQuery t -> [("q", t)]+ TrackQuery {..} ->+ [("track_name", queryName)]+ ++ [("artist_name", artist) | Just artist <- pure queryArtist]+ ++ [("album_name", album) | Just album <- pure queryAlbum] -- | Publish Lyrics ('publish') without requesting and solving challenge -- Calls @\/api\/publish@ publish' :: (HasCallStack) => PublishToken -> PublishRequest -> API (Either PublishError ()) publish' token request = do- 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+ resp <-+ HTTP.post "/publish" [("X-Publish-Token", encodeUtf8 token)] $+ A.encode request+ case resp.responseStatus.statusCode of 400 -> pure $ Left IncorrectToken 201 -> pure $ Right () s -> error $ "Unexpected status code on publish endpoint: " <> show s@@ -169,10 +138,7 @@ -- Challenge {prefix = "BVNC...XoVu1H", target = "000000FF0...00000"} requestChallenge :: API Challenge requestChallenge = do- api <- ask- let req = api {method = "POST", path = api.path <> "/request-challenge"}- man <- liftIO getGlobalManager- resp <- liftIO $ httpLbs req man+ resp <- HTTP.post "/request-challenge" [] "" pure $ decode resp.responseBody -- | Solve proof-of-work challenge for publish
+ src/LrcLib/HTTP.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}++module LrcLib.HTTP where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Reader (ask)+import Data.Bifunctor (second)+import Data.ByteString (ByteString)+import Data.ByteString.Lazy qualified as BSL+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import LrcLib.Types+import Network.HTTP.Client+ ( Request (method, path, queryString, requestBody, requestHeaders),+ RequestBody (RequestBodyLBS),+ Response,+ httpLbs,+ )+import Network.HTTP.Client.TLS (getGlobalManager)+import Network.HTTP.Types (RequestHeaders, renderSimpleQuery)++type ByteStringL = BSL.ByteString++post ::+ ByteString -> RequestHeaders -> ByteStringL -> API (Response ByteStringL)+post subpath requestHeaders body = do+ api <- ask+ let req =+ api+ { method = "POST",+ path = api.path <> subpath,+ requestHeaders,+ requestBody = RequestBodyLBS body+ }+ liftIO do+ man <- getGlobalManager+ httpLbs req man++get :: ByteString -> [(ByteString, Text)] -> API (Response ByteStringL)+get subpath query = do+ api <- ask+ let req =+ api+ { path = api.path <> subpath,+ queryString =+ renderSimpleQuery False $ map (second encodeUtf8) query+ }+ liftIO do+ man <- getGlobalManager+ httpLbs req man