diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown new file mode 100644 --- /dev/null +++ b/CHANGELOG.markdown @@ -0,0 +1,36 @@ +0.5.0 +===== + + * Fixed `http-client`'s `Manager` misuse: every call to `lastfm*` takes a + `Connection` parameter now and multiple calls should share it. + +0.4.1.0 +======= + + * Updated `lens` dependency + + * Switched to `network-uri` package + +0.4.0.0 +======= + + * `http-conduit` exceptions aren't propagate further into user code anymore + + * XML responses are parsed into `Document` type from `xml-conduit` + +0.3.2.0 +======= + + * Fixed `auth.getMobileSession` API method + + * Provided `lastfm_` function for making requests without parsing response. That is most useful for `POST` requests like `N.L.Track.love` + +0.3.0.0 +======= + + * Supported batch operations for `N.L.Track.scrobble`, `N.L.Library.{addAlbum,addArtist}` + +0.2.0.0 +======= + + * Vastly simplified internal representations leading to simpler library interface diff --git a/CHANGELOG.md b/CHANGELOG.md deleted file mode 100644 --- a/CHANGELOG.md +++ /dev/null @@ -1,30 +0,0 @@ -0.4.1.0 -======= - - * Updated `lens` dependency - - * Switched to `network-uri` package - -0.4.0.0 -======= - - * `http-conduit` exceptions aren't propagate further into user code anymore - - * XML responses are parsed into `Document` type from `xml-conduit` - -0.3.2.0 -======= - - * Fixed `auth.getMobileSession` API method - - * Provided `lastfm_` function for making requests without parsing response. That is most useful for `POST` requests like `N.L.Track.love` - -0.3.0.0 -======= - - * Supported batch operations for `N.L.Track.scrobble`, `N.L.Library.{addAlbum,addArtist}` - -0.2.0.0 -======= - - * Vastly simplified internal representations leading to simpler library interface diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -0,0 +1,127 @@ +liblastfm +========= +[![Hackage](https://budueba.com/hackage/liblastfm)](https://hackage.haskell.org/package/liblastfm) +[![Build Status](https://secure.travis-ci.org/supki/liblastfm.png?branch=master)](https://travis-ci.org/supki/liblastfm) + +Complete API interface to [last.fm][last.fm] service. +Documentation is available in two flavours: + + * original [API reference][last.fm/api] + + * liblastfm [haddocks][liblastfm/haddocks] + +Introduction +------------ +liblastfm provides Applicative interface for constructing requests. Also, it handles all machinery needed to prepare request for sending: + + * [signing][last.fm/sign] + + * url-encoding + + * miscellaneous stuff like choosing correct HTTP method, etc + +Once request is ready, liblastfm can send it and get you back a response. +Response format might be: + + * [aeson][aeson] `Value` for json queries + + * [xml-conduit][xml-conduit] `Document` for xml queries + +Installation +------------ +To install either use hackage: + + % cabal install liblastfm + +Or git: + + % git clone git@github.com:supki/liblastfm + % cd liblastfm + % cabal install + +Usage +----- +Suppose, you need to use [`tag.search`][last.fm/api-usage] API method. +First find it in liblastfm: `Tag` would be the name of the module and `search` would be the name of function. [Here it is][liblastfm/haddocks-usage]. +So import a couple of modules: + + >>> import Network.Lastfm -- a bunch of useful utilities + >>> import qualified Network.Lastfm.Tag as Tag -- for Tag.search + +Now you may you applicative `<*>` for required and `<*` or `*>` for optional parameters to construct +desired request: + + Tag.search <*> tag "russian-folk" <* limit 3 <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json + +To send constructed request use `lastfm`: + + >>> lastfm $ Tag.search <*> tag "russian-folk" <* limit 10 <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json + Just (Object fromList [("results",Object fromList [("tagmatches", ... + +[Wiki][liblastfm/wiki] describes how to parse responses. + +FAQ +--- + +**Q: I'm getting the following error. How do I fix it?** + +``` +>>> Artist.getInfo <*> artist "Pink Floyd" <*> apiKey "29effec263316a1f8a97f753caaa83e0" + +:8:27: + Couldn't match expected type `Data.Text.Lazy.Internal.Text' + with actual type `[Char] +``` + +A: This means you haven't OverloadedStrings extension enabled. +To enable it (either one works): + + * type in `:set -XOverloadedStrings` while in ghci session. + + * add `{-# LANGUAGE OverloadedStrings #-}` to the top of the file + + * compile with `-XOverloadedStrings` switch + +**Q: I'm getting the following error. How do I fix it?** + +``` +>>> lastfm (Artist.getInfo <*> artist "Pink Floyd" <*> apiKey "29effec263316a1f8a97f753caaa83e0") + +:13:1: + No instance for (Show (IO (Either LastfmError r0))) + arising from a use of `print' + Possible fix: + add an instance declaration for (Show (IO (Either LastfmError r0))) + In the first argument of `print', namely `it' + In a stmt of an interactive GHCi command: print it +``` + +A: This error message indicates that GHC cannot infer response format for the `Request`. +To fix it, add use `json` or `xml` helpers, depending on your needs + +A note on testing +----------------- + +To test Lastfm API compatibility (`api` test suite)—specifically, authentication requiring +examples—you will need to set `HASKELL_LIBLASTFM_APIKEY`, `HASKELL_LIBLASTFM_SESSIONKEY`, +and `HASKELL_LIBLASTFM_SECRET` environment variables to your api key, session key, and +secret respectively; for example (bash): + +```bash +export HASKELL_LIBLASTFM_APIKEY="__API_KEY__" +export HASKELL_LIBLASTFM_SESSIONKEY="__SESSION_KEY__" +export HASKELL_LIBLASTFM_SECRET="__SECRET__" +``` + +Please, consult Lastfm API documentation and `examples/*-authentication.hs` +examples if you don't know where to get your credentials. + + [last.fm]: http://www.last.fm/ + [last.fm/api]: http://www.last.fm/api/intro + [last.fm/api-usage]: http://www.last.fm/api/show/tag.search + [last.fm/sign]: http://www.last.fm/api/authspec#8 + [liblastfm/haddocks]: http://supki.github.io/liblastfm/ + [liblastfm/haddocks-usage]: http://supki.github.com/liblastfm/Network-Lastfm-Tag.html#v:search + [liblastfm/wiki]: https://github.com/supki/liblastfm/wiki/How-to-parse-JSON-response + [aeson]: https://hackage.haskell.org/package/aeson + [xml-conduit]: https://hackage.haskell.org/package/xml-conduit diff --git a/README.md b/README.md deleted file mode 100644 --- a/README.md +++ /dev/null @@ -1,127 +0,0 @@ -liblastfm -========= -[![Hackage](https://budueba.com/hackage/liblastfm)](https://hackage.haskell.org/package/liblastfm) -[![Build Status](https://secure.travis-ci.org/supki/liblastfm.png?branch=develop)](https://travis-ci.org/supki/liblastfm) - -Complete API interface to [last.fm][last.fm] service. -Documentation is available in two flavours: - - * original [API reference][last.fm/api] - - * liblastfm [haddocks][liblastfm/haddocks] - -Introduction ------------- -liblastfm provides Applicative interface for constructing requests. Also, it handles all machinery needed to prepare request for sending: - - * [signing][last.fm/sign] - - * url-encoding - - * miscellaneous stuff like choosing correct HTTP method, etc - -Once request is ready, liblastfm can send it and get you back a response. -Response format might be: - - * [aeson][aeson] `Value` for json queries - - * [xml-conduit][xml-conduit] `Document` for xml queries - -Installation ------------- -To install either use hackage: - - % cabal install liblastfm - -Or git: - - % git clone git@github.com:supki/liblastfm - % cd liblastfm - % cabal install - -Usage ------ -Suppose, you need to use [`tag.search`][last.fm/api-usage] API method. -First find it in liblastfm: `Tag` would be the name of the module and `search` would be the name of function. [Here it is][liblastfm/haddocks-usage]. -So import a couple of modules: - - >>> import Network.Lastfm -- a bunch of useful utilities - >>> import qualified Network.Lastfm.Tag as Tag -- for Tag.search - -Now you may you applicative `<*>` for required and `<*` or `*>` for optional parameters to construct -desired request: - - Tag.search <*> tag "russian-folk" <* limit 3 <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json - -To send constructed request use `lastfm`: - - >>> lastfm $ Tag.search <*> tag "russian-folk" <* limit 10 <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json - Just (Object fromList [("results",Object fromList [("tagmatches", ... - -[Wiki][liblastfm/wiki] describes how to parse responses. - -FAQ ---- - -**Q: I'm getting the following error. How do I fix it?** - -``` ->>> Artist.getInfo <*> artist "Pink Floyd" <*> apiKey "29effec263316a1f8a97f753caaa83e0" - -:8:27: - Couldn't match expected type `Data.Text.Lazy.Internal.Text' - with actual type `[Char] -``` - -A: This means you haven't OverloadedStrings extension enabled. -To enable it (either one works): - - * type in `:set -XOverloadedStrings` while in ghci session. - - * add `{-# LANGUAGE OverloadedStrings #-}` to the top of the file - - * compile with `-XOverloadedStrings` switch - -**Q: I'm getting the following error. How do I fix it?** - -``` ->>> lastfm (Artist.getInfo <*> artist "Pink Floyd" <*> apiKey "29effec263316a1f8a97f753caaa83e0") - -:13:1: - No instance for (Show (IO (Either LastfmError r0))) - arising from a use of `print' - Possible fix: - add an instance declaration for (Show (IO (Either LastfmError r0))) - In the first argument of `print', namely `it' - In a stmt of an interactive GHCi command: print it -``` - -A: This error message indicates that GHC cannot infer response format for the `Request`. -To fix it, add use `json` or `xml` helpers, depending on your needs - -A note on testing ------------------ - -To test Lastfm API compatibility (`api` test suite)—specifically, authentication requiring -examples—you will need to set `HASKELL_LIBLASTFM_APIKEY`, `HASKELL_LIBLASTFM_SESSIONKEY`, -and `HASKELL_LIBLASTFM_SECRET` environment variables to your api key, session key, and -secret respectively; for example (bash): - -```bash -export HASKELL_LIBLASTFM_APIKEY="__API_KEY__" -export HASKELL_LIBLASTFM_SESSIONKEY="__SESSION_KEY__" -export HASKELL_LIBLASTFM_SECRET="__SECRET__" -``` - -Please, consult Lastfm API documentation and `examples/*-authentication.hs` -examples if you don't know where to get your credentials. - - [last.fm]: http://www.last.fm/ - [last.fm/api]: http://www.last.fm/api/intro - [last.fm/api-usage]: http://www.last.fm/api/show/tag.search - [last.fm/sign]: http://www.last.fm/api/authspec#8 - [liblastfm/haddocks]: http://supki.github.io/liblastfm/ - [liblastfm/haddocks-usage]: http://supki.github.com/liblastfm/Network-Lastfm-Tag.html#v:search - [liblastfm/wiki]: https://github.com/supki/liblastfm/wiki/How-to-parse-JSON-response - [aeson]: https://hackage.haskell.org/package/aeson - [xml-conduit]: https://hackage.haskell.org/package/xml-conduit diff --git a/example/README.markdown b/example/README.markdown new file mode 100644 --- /dev/null +++ b/example/README.markdown @@ -0,0 +1,82 @@ +# liblastfm examples + +## sort-friends + +Shows how to work with lastfm api and async to speed up getting 5 most compliable friends. + + * [async][async] + + * [lens-aeson][lens-aeson] + +--- + +## multitag-search + +Shows how to work lastfm api around to get search for multiple tags at once. + + * [aeson][aeson] + +--- + +## playcount + +Shows how to get user playcount. + + * [aeson][aeson] + + * [lens-aeson][lens-aeson] + +--- + +## recommendations + +Shows how to use signed queries + + * [lens-aeson][lens-aeson] + +--- + +## desktop-authentication + +Demonstrates [desktop application authentication][last.fm/desktop] flow. + + * [lens-aeson][lens-aeson] + +--- + +## web-authentication + +Demonstrates [web application authentication][last.fm/web] flow. + + * [happstack-server][happstack-server] + +--- + +## mobile-authentication + +Demonstrates [mobile application authentication][last.fm/mobile] flow. + + * [lens-aeson][lens-aeson] + +--- + +## [scrobblers][scrobblers] + +Advanced scrobbling techniques. + + * [netwire][netwire] + + * [libmpd][libmpd] + + * [lens-aeson][lens-aeson] + + [aeson]: https://hackage.haskell.org/package/aeson + [async]: https://hackage.haskell.org/package/async + [happstack-server]: https://hackage.haskell.org/package/happstack-server + [lens-aeson]: https://hackage.haskell.org/package/lens-aeson + [libmpd]: https://hackage.haskell.org/package/libmpd + [netwire]: https://hackage.haskell.org/package/netwire + [scrobblers]: https://github.com/supki/scrobblers + [last.fm/desktop]: http://www.last.fm/api/desktopauth + [last.fm/web]: http://www.last.fm/api/webauth + [last.fm/mobile]: http://www.last.fm/api/mobileauth diff --git a/example/desktop-authentication.hs b/example/desktop-authentication.hs new file mode 100644 --- /dev/null +++ b/example/desktop-authentication.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Desktop application authentication flow example +-- +-- Please remember to substitute __YOUR_API_KEY__ +-- and __YOUR_SECRET__ for real values +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import Data.Foldable (for_) -- base +import Data.Text (unpack) -- text +import Network.Lastfm -- liblastfm +import Network.Lastfm.Authentication -- liblastfm + + +main :: IO () +main = withConnection $ \conn -> do + r <- lastfm conn $ getToken <*> apiKey ak <* json + for_ (r ^? folded.key "token"._String) $ \t -> do + putStrLn $ "approve: " ++ link (apiKey ak <* token t) + _ <- getChar + r' <- lastfm conn . sign s $ getSession <*> token t <*> apiKey ak <* json + for_ (r' ^? folded.key "session".key "key"._String) $ \sk -> + putStrLn $ "session key: " ++ unpack sk + where + ak = "__YOUR_API_KEY__" + s = "__YOUR_SECRET__" diff --git a/example/liblastfm-examples.cabal b/example/liblastfm-examples.cabal new file mode 100644 --- /dev/null +++ b/example/liblastfm-examples.cabal @@ -0,0 +1,120 @@ +name: liblastfm-examples +version: 0.5.0 +synopsis: Liblastfm examples +license: MIT +license-file: LICENSE +author: Matvey Aksenov, Dmitry Malikov +maintainer: Matvey Aksenov +category: Network APIs +description: Haddock documentation isn't enough to get feeling of the library +cabal-version: >= 1.10 +build-type: Simple + +executable sort-friends + default-language: + Haskell2010 + build-depends: + base >= 4 && < 5 + , liblastfm >= 0.4.0.0 + , async + , text + , aeson + , lens >= 4.4 + , lens-aeson >= 1.0.0.1 + main-is: + sort-friends.hs + ghc-options: + -Wall + -fno-warn-unused-do-bind + -threaded + +executable multitag-search + default-language: + Haskell2010 + build-depends: + base >= 4 && < 5 + , liblastfm >= 0.4.0.0 + , text + , lens >= 4.4 + , aeson + main-is: + multitag-search.hs + ghc-options: + -Wall + -fno-warn-unused-do-bind + +executable web-authentication + default-language: + Haskell2010 + build-depends: + base >= 4 && < 5 + , liblastfm >= 0.4.0.0 + , lens >= 4.4 + , lens-aeson >= 1.0.0.1 + , happstack-server >= 7.3 + , transformers + main-is: + web-authentication.hs + ghc-options: + -Wall + -fno-warn-unused-do-bind + +executable desktop-authentication + default-language: + Haskell2010 + build-depends: + base >= 4 && < 5 + , liblastfm >= 0.4.0.0 + , text + , lens >= 4.4 + , lens-aeson >= 1.0.0.1 + main-is: + desktop-authentication.hs + ghc-options: + -Wall + -fno-warn-unused-do-bind + +executable mobile-authentication + default-language: + Haskell2010 + build-depends: + base >= 4 && < 5 + , liblastfm >= 0.4.0.0 + , lens >= 4.4 + , lens-aeson >= 1.0.0.1 + , text + main-is: + mobile-authentication.hs + ghc-options: + -Wall + +executable playcount + default-language: + Haskell2010 + build-depends: + base >= 4 && < 5 + , liblastfm >= 0.4.0.0 + , text + , lens >= 4.4 + , lens-aeson >= 1.0.0.1 + main-is: + playcount.hs + ghc-options: + -Wall + -fno-warn-unused-do-bind + +executable recommendations + default-language: + Haskell2010 + build-depends: + base >= 4 && < 5 + , liblastfm >= 0.4.0.0 + , text + , aeson + , lens >= 4.4 + , lens-aeson >= 1.0.0.1 + main-is: + recommendations.hs + ghc-options: + -Wall + -fno-warn-unused-do-bind diff --git a/example/mobile-authentication.hs b/example/mobile-authentication.hs new file mode 100644 --- /dev/null +++ b/example/mobile-authentication.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Mobile application authentication flow example +-- +-- Please remember to substitute __YOUR_API_KEY__, +-- __YOUR_SECRET__, __USERNAME__ and __PASSWORD__ +-- for real values +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import qualified Data.Text as Text -- text +import qualified Data.Text.IO as Text -- text +import Network.Lastfm -- liblastfm +import Network.Lastfm.Authentication -- liblastfm + +main :: IO () +main = withConnection $ \conn -> do + r <- lastfm conn . sign s $ getMobileSession <*> username u <*> password p <*> apiKey ak <* json + let maybeSk = r ^? folded.key "session".key "key"._String + Text.putStrLn $ case maybeSk of + Just sk -> "Mobile session key: " `Text.append` sk + Nothing -> "Mobile session key wasn't retrieved, something goes wrong" + where + ak = "__YOUR_API_KEY__" + s = "__YOUR_SECRET__" + u = "__USERNAME__" + p = "__PASSWORD__" diff --git a/example/multitag-search.hs b/example/multitag-search.hs new file mode 100644 --- /dev/null +++ b/example/multitag-search.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} +{- This example shows how to do multitag search even + - if it's not provided by Lastfm API + - + - Sample output: + - + - $> ./examples/multitag-search.hs j-pop anime anime-ost + - 坂本真綾 + - KOTOKO + - Lisa + - 茅原実里 + -} +import Data.Aeson.Types -- aeson +import Data.List (intersect) -- base +import Data.Maybe -- base +import Data.Text (Text) -- text +import qualified Data.Text as Text -- text +import qualified Data.Text.IO as Text -- text +import Network.Lastfm -- liblastfm +import qualified Network.Lastfm.Tag as Tag -- liblastfm +import System.Environment (getArgs) -- base + +{-# ANN module ("HLint: ignore Use camelCase" :: String) #-} + + +main :: IO () +main = mapM_ Text.putStrLn =<< withConnection . getArtists . map Text.pack =<< getArgs + + +getArtists :: [Text] -> Connection -> IO [Text] +getArtists ts conn = do + names <- mapM request ts + case catMaybes names of + [] -> return [] + ns -> return (foldl1 intersect ns) + where + request = fmap (either (const Nothing) (parseMaybe gta)) . query + + query t = lastfm conn $ + Tag.getTopArtists <*> tag t <* limit 100 <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json + +gta :: Value -> Parser [Text] +gta o = parseJSON o >>= (.: "topartists") >>= (.: "artist") >>= mapM (.: "name") diff --git a/example/playcount.hs b/example/playcount.hs new file mode 100644 --- /dev/null +++ b/example/playcount.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} +-- This example shows how to get user playcount with lens-aeson +-- +-- Sample session: +-- +-- $> ./examples/playcount.hs +-- >>> MCDOOMDESTROYER +-- 96698 +-- >>> smpcln +-- 95518 +-- >>> ^C +-- $> +--} +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import Control.Monad -- base +import Data.Text (Text) -- text +import qualified Data.Text.IO as Text -- text +import Network.Lastfm -- liblastfm +import qualified Network.Lastfm.User as User -- liblastfm +import qualified System.IO as IO -- base + + +main :: IO () +main = withConnection $ \conn -> + forever $ do Text.putStr ">>> "; flush; Text.getLine >>= playcount conn >>= Text.putStrLn + +flush :: IO () +flush = IO.hFlush IO.stdout + +playcount :: Connection -> Text -> IO Text +playcount conn u = do + res <- lastfm conn + (User.getInfo <*> user u <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json) + return $ case res ^? folded.key "user".key "playcount"._String of + Nothing -> "Playcount not found" + Just x -> x +{-# ANN playcount ("HLint: ignore Use fromMaybe" :: String) #-} diff --git a/example/recommendations.hs b/example/recommendations.hs new file mode 100644 --- /dev/null +++ b/example/recommendations.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{- This example shows how to use signed queries + - to get user recommendations + - + - Sample output: + - + - Roger Rotor + - Neurosis + - Asche + - SKYHARBOR + - Cylob + - Mouth of the Architect + -} + +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import Data.Traversable (for) -- base +import Data.Aeson (Value) -- aeson +import Data.Foldable (Foldable) -- base +import Data.Int (Int64) -- base +import Data.Text (Text) -- text +import qualified Data.Text.IO as Text -- text +import Network.Lastfm -- liblastfm +import qualified Network.Lastfm.User as User -- liblastfm + + +main :: IO () +main = withConnection $ \conn -> do + r <- for [1..pages] $ \p -> parse `fmap` query conn (User.getRecommendedArtists <* page p) + mapM_ Text.putStrLn (concat r) + +-- Construct signed query +query :: Connection -> Request JSON (APIKey -> SessionKey -> Sign) -> IO (Either LastfmError Value) +query conn r = lastfm conn $ sign secret (r <*> ak <*> sk <* json) + where + ak = apiKey "__YOUR_API_KEY__" + sk = sessionKey "__YOUR_SESSION_KEY__" + secret = "__YOUR_SECRET__" + +-- Other query parameters +total, pages :: Int64 +total = 250 +pages = total `div` 50 -- 50 is the default number of recommendations per page + +-- Parse artist names from response +parse :: Foldable f => f Value -> [Text] +parse x = x ^.. folded.key "recommendations".key "artist".values.key "name"._String diff --git a/example/sort-friends.hs b/example/sort-friends.hs new file mode 100644 --- /dev/null +++ b/example/sort-friends.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{- This example shows how to extract all + - user friends, get their similarity score and + - then sort them based on it outputting top 5 + - + - User friends of which are searched is 'target' + - + - Most of hard work there is on 'aeson-lens' actually :) + - + - Sample output: + - + - % ./examples/sort-friends.hs + - Artvart: 0.9969767332077 + - smpcln: 0.9965825676918 + - nv0id: 0.86804795265198 + - QueenrXy: 0.5932799577713 + - GhostOsaka: 0.2875879406929 + - + - Notice: you may want to adjust maximum open files limit + - if testing on users with relatively large friends count + -} +import Control.Concurrent.Async -- async +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import Data.Aeson (Value) -- aeson +import Data.Function (on) -- base +import Data.List (sortBy) -- base +import Data.Maybe (fromMaybe) -- base +import Data.Monoid ((<>)) -- base +import Data.Text (Text) -- text +import Data.Text.Lens (unpacked) -- lens +import qualified Data.Text.IO as Text -- text +import Network.Lastfm hiding (to) -- liblastfm +import qualified Network.Lastfm.User as User -- liblastfm +import qualified Network.Lastfm.Tasteometer as Tasteometer -- liblastfm +import Text.Read (readMaybe) -- base + + +type Score = Text + + +main :: IO () +main = withConnection $ \conn -> + pages conn >>= scores conn . names >>= pretty + where + names x = x ^.. folded.folded.key "friends".key "user"._Array.folded.key "name"._String + +pages :: Connection -> IO [Either LastfmError Value] +pages conn = do + first <- query conn (User.getFriends <*> user target) + let ps = fromMaybe 1 (preview total first) + (first :) <$> forConcurrently [2..ps] (\p -> query conn (User.getFriends <*> user target <* page p)) + where + total = folded.key "friends".key "@attr".key "totalPages"._String.unpacked.to readMaybe.folded + +scores :: Connection -> [Text] -> IO [(Text, Score)] +scores conn xs = zip xs <$> forConcurrently xs (\x -> do + r <- query conn (Tasteometer.compare (user target) (user x)) + return (fromMaybe "0" (preview score r))) + where + score = folded.key "comparison".key "result".key "score"._String + +forConcurrently :: [a] -> (a -> IO b) -> IO [b] +forConcurrently = flip mapConcurrently + +pretty :: [(Text, Score)] -> IO () +pretty = mapM_ (\(n,s) -> Text.putStrLn $ n <> ": " <> s) . take 5 . sortBy (flip compare `on` snd) + +query :: Connection -> Request JSON (APIKey -> Ready) -> IO (Either LastfmError Value) +query conn r = lastfm conn (r <*> apiKey "234fc6e0f41f6ef99b7bd62ebaf8d318" <* json) + +target :: Text +target = "MCDOOMDESTROYER" diff --git a/example/web-authentication.hs b/example/web-authentication.hs new file mode 100644 --- /dev/null +++ b/example/web-authentication.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Web application authentication flow example +-- +-- Please remember to substitute __YOUR_API_KEY__, +-- __YOUR_SECRET__ and __YOUR_CALLBACK__ for real values +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import Control.Monad -- base +import Control.Monad.IO.Class (liftIO) -- transformers +import Data.IORef -- base +import Happstack.Server -- happstack-server +import Network.Lastfm -- liblastfm +import Network.Lastfm.Authentication -- liblastfm + + +main :: IO () +main = withConnection $ \conn -> do + sessions <- newIORef [] + simpleHTTP nullConf $ msum + [ dir "authenticate" $ seeOther (link $ apiKey ak <* callback "__YOUR_CALLBACK__") "" + , dir "save" $ do + t <- lookText' "token" + r <- liftIO . lastfm conn . sign s $ getSession <*> token t <*> apiKey ak <* json + case r ^? folded.key "session".key "key"._String of + Just sk -> liftIO $ modifyIORef' sessions (sk:) + Nothing -> return () + ok "Saved." + , dir "show" $ liftIO (readIORef sessions) >>= ok . show + ] + where + ak = "__YOUR_API_KEY__" + s = "__YOUR_SECRET__" diff --git a/examples/README.md b/examples/README.md deleted file mode 100644 --- a/examples/README.md +++ /dev/null @@ -1,82 +0,0 @@ -# liblastfm examples - -## sort-friends - -Shows how to work with lastfm api and async to speed up getting 5 most compliable friends. - - * [async][async] - - * [lens-aeson][lens-aeson] - ---- - -## multitag-search - -Shows how to work lastfm api around to get search for multiple tags at once. - - * [aeson][aeson] - ---- - -## playcount - -Shows how to get user playcount. - - * [aeson][aeson] - - * [lens-aeson][lens-aeson] - ---- - -## recommendations - -Shows how to use signed queries - - * [lens-aeson][lens-aeson] - ---- - -## desktop-authentication - -Demonstrates [desktop application authentication][last.fm/desktop] flow. - - * [lens-aeson][lens-aeson] - ---- - -## web-authentication - -Demonstrates [web application authentication][last.fm/web] flow. - - * [happstack-server][happstack-server] - ---- - -## mobile-authentication - -Demonstrates [mobile application authentication][last.fm/mobile] flow. - - * [lens-aeson][lens-aeson] - ---- - -## [scrobblers][scrobblers] - -Advanced scrobbling techniques. - - * [netwire][netwire] - - * [libmpd][libmpd] - - * [lens-aeson][lens-aeson] - - [aeson]: https://hackage.haskell.org/package/aeson - [async]: https://hackage.haskell.org/package/async - [happstack-server]: https://hackage.haskell.org/package/happstack-server - [lens-aeson]: https://hackage.haskell.org/package/lens-aeson - [libmpd]: https://hackage.haskell.org/package/libmpd - [netwire]: https://hackage.haskell.org/package/netwire - [scrobblers]: https://github.com/supki/scrobblers - [last.fm/desktop]: http://www.last.fm/api/desktopauth - [last.fm/web]: http://www.last.fm/api/webauth - [last.fm/mobile]: http://www.last.fm/api/mobileauth diff --git a/examples/desktop-authentication.hs b/examples/desktop-authentication.hs deleted file mode 100644 --- a/examples/desktop-authentication.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- | Desktop application authentication flow example --- --- Please remember to substitute __YOUR_API_KEY__ --- and __YOUR_SECRET__ for real values -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import Data.Foldable (for_) -- base -import Data.Text (unpack) -- text -import Network.Lastfm -- liblastfm -import Network.Lastfm.Authentication -- liblastfm - - -main :: IO () -main = do - r <- lastfm $ getToken <*> apiKey ak <* json - for_ (r ^? folded.key "token"._String) $ \t -> do - putStrLn $ "approve: " ++ link (apiKey ak <* token t) - _ <- getChar - r' <- lastfm . sign s $ getSession <*> token t <*> apiKey ak <* json - for_ (r' ^? folded.key "session".key "key"._String) $ \sk -> - putStrLn $ "session key: " ++ unpack sk - where - ak = "__YOUR_API_KEY__" - s = "__YOUR_SECRET__" diff --git a/examples/liblastfm-examples.cabal b/examples/liblastfm-examples.cabal deleted file mode 100644 --- a/examples/liblastfm-examples.cabal +++ /dev/null @@ -1,105 +0,0 @@ -name: liblastfm-examples -version: 0.4.1.0 -synopsis: Examples for liblastfm -license: MIT -license-file: LICENSE -author: Matvey Aksenov, Dmitry Malikov -maintainer: Matvey Aksenov -category: Network APIs -description: Haddock documentation isn't enough to get feeling of the library -cabal-version: >= 1.10 -build-type: Simple - -executable sort-friends - default-language: Haskell2010 - build-depends: - base >= 4 && < 5 - , liblastfm >= 0.4.0.0 - , async - , text - , aeson - , lens >= 4.4 - , lens-aeson >= 1.0.0.1 - main-is: sort-friends.hs - ghc-options: - -Wall - -fno-warn-unused-do-bind - -threaded - -executable multitag-search - default-language: Haskell2010 - build-depends: - base >= 4 && < 5 - , liblastfm >= 0.4.0.0 - , text - , lens >= 4.4 - , aeson - main-is: multitag-search.hs - ghc-options: - -Wall - -fno-warn-unused-do-bind - -executable web-authentication - default-language: Haskell2010 - build-depends: - base >= 4 && < 5 - , liblastfm >= 0.4.0.0 - , lens >= 4.4 - , lens-aeson >= 1.0.0.1 - , happstack-server >= 7.3 - , transformers - main-is: web-authentication.hs - ghc-options: - -Wall - -fno-warn-unused-do-bind - -executable desktop-authentication - default-language: Haskell2010 - build-depends: - base >= 4 && < 5 - , liblastfm >= 0.4.0.0 - , text - , lens >= 4.4 - , lens-aeson >= 1.0.0.1 - main-is: desktop-authentication.hs - ghc-options: - -Wall - -fno-warn-unused-do-bind - -executable mobile-authentication - default-language: Haskell2010 - build-depends: - base >= 4 && < 5 - , liblastfm >= 0.4.0.0 - , lens >= 4.4 - , lens-aeson >= 1.0.0.1 - , text - main-is: mobile-authentication.hs - ghc-options: - -Wall - -executable playcount - default-language: Haskell2010 - build-depends: - base >= 4 && < 5 - , liblastfm >= 0.4.0.0 - , text - , lens >= 4.4 - , lens-aeson >= 1.0.0.1 - main-is: playcount.hs - ghc-options: - -Wall - -fno-warn-unused-do-bind - -executable recommendations - default-language: Haskell2010 - build-depends: - base >= 4 && < 5 - , liblastfm >= 0.4.0.0 - , text - , aeson - , lens >= 4.4 - , lens-aeson >= 1.0.0.1 - main-is: recommendations.hs - ghc-options: -Wall - -fno-warn-unused-do-bind diff --git a/examples/mobile-authentication.hs b/examples/mobile-authentication.hs deleted file mode 100644 --- a/examples/mobile-authentication.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- | Mobile application authentication flow example --- --- Please remember to substitute __YOUR_API_KEY__, --- __YOUR_SECRET__, __USERNAME__ and __PASSWORD__ --- for real values -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import qualified Data.Text as Text -- text -import qualified Data.Text.IO as Text -- text -import Network.Lastfm -- liblastfm -import Network.Lastfm.Authentication -- liblastfm - -main :: IO () -main = do - r <- lastfm . sign s $ getMobileSession <*> username u <*> password p <*> apiKey ak <* json - let maybeSk = r ^? folded.key "session".key "key"._String - Text.putStrLn $ case maybeSk of - Just sk -> "Mobile session key: " `Text.append` sk - Nothing -> "Mobile session key wasn't retrieved, something goes wrong" - where - ak = "__YOUR_API_KEY__" - s = "__YOUR_SECRET__" - u = "__USERNAME__" - p = "__PASSWORD__" diff --git a/examples/multitag-search.hs b/examples/multitag-search.hs deleted file mode 100644 --- a/examples/multitag-search.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{- This example shows how to do multitag search even - - if it's not provided by Lastfm API - - - - Sample output: - - - - $> ./examples/multitag-search.hs - - 坂本真綾 - - KOTOKO - - Lisa - - 茅原実里 - -} -import Data.Aeson.Types -- aeson -import Data.List (intersect) -- base -import Data.Maybe -- base -import Data.Text (Text) -- text -import qualified Data.Text.IO as Text -- text -import Network.Lastfm -- liblastfm -import qualified Network.Lastfm.Tag as Tag -- liblastfm - -{-# ANN module ("HLint: ignore Use camelCase" :: String) #-} - - -main :: IO () -main = mapM_ Text.putStrLn =<< get_artists multitags - - -get_artists :: [Text] -> IO [Text] -get_artists ts = do - names <- mapM request ts - case catMaybes names of - [] -> return [] - ns -> return (foldl1 intersect ns) - where - request = fmap (either (const Nothing) (parseMaybe gta)) . query - - query t = lastfm $ Tag.getTopArtists <*> tag t <* limit 100 <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json - -gta :: Value -> Parser [Text] -gta o = parseJSON o >>= (.: "topartists") >>= (.: "artist") >>= mapM (.: "name") - -multitags :: [Text] -multitags = ["j-pop", "anime", "anime-ost"] diff --git a/examples/playcount.hs b/examples/playcount.hs deleted file mode 100644 --- a/examples/playcount.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{- This example shows how to get user playcount with lens-aeson - - - - Sample session: - - - - $> ./examples/playcount.hs - - >>> MCDOOMDESTROYER - - 96698 - - >>> smpcln - - 95518 - - >>> ^C - - $> - -} -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import Control.Monad -- base -import Data.Maybe -- base -import Data.Text (Text) -- text -import qualified Data.Text.IO as Text -- text -import Network.Lastfm -- liblastfm -import qualified Network.Lastfm.User as User -- liblastfm -import System.IO (hFlush, stdout) -- base - - -main :: IO () -main = forever $ Text.putStr ">>> " >> hFlush stdout >> Text.getLine >>= playcount >>= Text.putStrLn - -playcount :: Text -> IO Text -playcount u = - lastfm (User.getInfo <*> user u <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json) <&> \rsp -> - fromMaybe "Playcount not found" (rsp ^? folded.key "user".key "playcount"._String) diff --git a/examples/recommendations.hs b/examples/recommendations.hs deleted file mode 100644 --- a/examples/recommendations.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{- This example shows how to use signed queries - - to get user recommendations - - - - Sample output: - - - - Roger Rotor - - Neurosis - - Asche - - SKYHARBOR - - Cylob - - Mouth of the Architect - -} - -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import Data.Traversable (for) -- base -import Data.Aeson (Value) -- aeson -import Data.Foldable (Foldable) -- base -import Data.Int (Int64) -- base -import Data.Text (Text) -- text -import qualified Data.Text.IO as Text -- text -import Network.Lastfm -- liblastfm -import qualified Network.Lastfm.User as User -- liblastfm - - -main :: IO () -main = do - r <- for [1..pages] $ \p -> parse `fmap` query (User.getRecommendedArtists <* page p) - mapM_ Text.putStrLn (concat r) - --- Construct signed query -query :: Request JSON (APIKey -> SessionKey -> Sign) -> IO (Either LastfmError Value) -query r = lastfm $ sign secret (r <*> ak <*> sk <* json) - where - ak = apiKey "__YOUR_API_KEY__" - sk = sessionKey "__YOUR_SESSION_KEY__" - secret = "__YOUR_SECRET__" - --- Other query parameters -total, pages :: Int64 -total = 250 -pages = total `div` 50 -- 50 is the default number of recommendations per page - --- Parse artist names from response -parse :: Foldable f => f Value -> [Text] -parse x = x ^.. folded.key "recommendations".key "artist"._Array.folded.key "name"._String diff --git a/examples/sort-friends.hs b/examples/sort-friends.hs deleted file mode 100644 --- a/examples/sort-friends.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{- This example shows how to extract all - - user friends, get their similarity score and - - then sort them based on it outputting top 5 - - - - User friends of which are searched is 'target' - - - - Most of hard work there is on 'aeson-lens' actually :) - - - - Sample output: - - - - % ./examples/sort-friends.hs - - Artvart: 0.9969767332077 - - smpcln: 0.9965825676918 - - nv0id: 0.86804795265198 - - QueenrXy: 0.5932799577713 - - GhostOsaka: 0.2875879406929 - - - - Notice: you may want to adjust maximum open files limit - - if testing on users with relatively large friends count - -} -import Control.Concurrent.Async -- async -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import Data.Aeson (Value) -- aeson -import Data.Function (on) -- base -import Data.List (sortBy) -- base -import Data.Maybe (fromMaybe) -- base -import Data.Monoid ((<>)) -- base -import Data.Text (Text) -- text -import Data.Text.Lens (unpacked) -- lens -import qualified Data.Text.IO as Text -- text -import Network.Lastfm hiding (to) -- liblastfm -import qualified Network.Lastfm.User as User -- liblastfm -import qualified Network.Lastfm.Tasteometer as Tasteometer -- liblastfm -import Text.Read (readMaybe) -- base - - -type Score = Text - - -main :: IO () -main = pages >>= scores . names >>= pretty - where - names x = x ^.. folded.folded.key "friends".key "user"._Array.folded.key "name"._String - -pages :: IO [Either LastfmError Value] -pages = do - first <- query (User.getFriends <*> user target) - let ps = fromMaybe 1 (preview total first) - (first :) <$> forConcurrently [2..ps] (\p -> query (User.getFriends <*> user target <* page p)) - where - total = folded.key "friends".key "@attr".key "totalPages"._String.unpacked.to readMaybe.folded - -scores :: [Text] -> IO [(Text, Score)] -scores xs = zip xs <$> forConcurrently xs (\x -> do - r <- query (Tasteometer.compare (user target) (user x)) - return (fromMaybe "0" (preview score r))) - where - score = folded.key "comparison".key "result".key "score"._String - -forConcurrently :: [a] -> (a -> IO b) -> IO [b] -forConcurrently = flip mapConcurrently - -pretty :: [(Text, Score)] -> IO () -pretty = mapM_ (\(n,s) -> Text.putStrLn $ n <> ": " <> s) . take 5 . sortBy (flip compare `on` snd) - -query :: Request JSON (APIKey -> Ready) -> IO (Either LastfmError Value) -query r = lastfm (r <*> apiKey "234fc6e0f41f6ef99b7bd62ebaf8d318" <* json) - -target :: Text -target = "MCDOOMDESTROYER" diff --git a/examples/web-authentication.hs b/examples/web-authentication.hs deleted file mode 100644 --- a/examples/web-authentication.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- | Web application authentication flow example --- --- Please remember to substitute __YOUR_API_KEY__, --- __YOUR_SECRET__ and __YOUR_CALLBACK__ for real values -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import Control.Monad -- base -import Control.Monad.IO.Class (liftIO) -- transformers -import Data.IORef -- base -import Happstack.Server -- happstack-server -import Network.Lastfm -- liblastfm -import Network.Lastfm.Authentication -- liblastfm - - -main :: IO () -main = do - sessions <- newIORef [] - simpleHTTP nullConf $ msum - [ dir "authenticate" $ seeOther (link $ apiKey ak <* callback "__YOUR_CALLBACK__") "" - , dir "save" $ do - t <- lookText' "token" - r <- liftIO . lastfm . sign s $ getSession <*> token t <*> apiKey ak <* json - case r ^? folded.key "session".key "key"._String of - Just sk -> liftIO $ modifyIORef' sessions (sk:) - Nothing -> return () - ok "Saved." - , dir "show" $ liftIO (readIORef sessions) >>= ok . show - ] - where - ak = "__YOUR_API_KEY__" - s = "__YOUR_SECRET__" diff --git a/liblastfm.cabal b/liblastfm.cabal --- a/liblastfm.cabal +++ b/liblastfm.cabal @@ -1,5 +1,5 @@ name: liblastfm -version: 0.4.1.0 +version: 0.5.0 synopsis: Lastfm API interface license: MIT license-file: LICENSE @@ -11,17 +11,17 @@ cabal-version: >= 1.10 build-type: Simple extra-source-files: - README.md - CHANGELOG.md - examples/README.md - examples/desktop-authentication.hs - examples/liblastfm-examples.cabal - examples/mobile-authentication.hs - examples/multitag-search.hs - examples/playcount.hs - examples/recommendations.hs - examples/sort-friends.hs - examples/web-authentication.hs + README.markdown + CHANGELOG.markdown + example/README.markdown + example/desktop-authentication.hs + example/liblastfm-examples.cabal + example/mobile-authentication.hs + example/multitag-search.hs + example/playcount.hs + example/recommendations.hs + example/sort-friends.hs + example/web-authentication.hs source-repository head type: git @@ -33,7 +33,8 @@ manual: True library - default-language: Haskell2010 + default-language: + Haskell2010 build-depends: aeson , base >= 4 && < 5 @@ -81,22 +82,27 @@ test-suite api if !flag(test-api) buildable: False - default-language: Haskell2010 + default-language: + Haskell2010 + type: + exitcode-stdio-1.0 build-depends: aeson , base >= 4 && < 5 , bytestring , HUnit + , http-client + , http-client-tls , lens-aeson >= 1.0.0.1 , lens >= 4.4 , liblastfm , hspec , text , xml-html-conduit-lens >= 0.3 - type: exitcode-stdio-1.0 hs-source-dirs: test/api - main-is: Spec.hs + main-is: + Spec.hs other-modules: SpecHelper Json.AlbumSpec @@ -131,7 +137,10 @@ -fno-warn-unused-do-bind test-suite spec - default-language: Haskell2010 + default-language: + Haskell2010 + type: + exitcode-stdio-1.0 build-depends: aeson , base >= 4 && < 5 @@ -153,11 +162,11 @@ , void , xml-conduit , xml-html-conduit-lens >= 0.3 - type: exitcode-stdio-1.0 hs-source-dirs: src test/spec - main-is: Spec.hs + main-is: + Spec.hs other-modules: Network.Lastfm.ResponseSpec ghc-options: diff --git a/src/Network/Lastfm/Response.hs b/src/Network/Lastfm/Response.hs --- a/src/Network/Lastfm/Response.hs +++ b/src/Network/Lastfm/Response.hs @@ -10,19 +10,18 @@ -- $sign Secret(..) , sign - -- * Get response - , Supported - , Format(..) + -- * Perform requests + , Connection + , withConnection , lastfm , lastfm_ + , Supported + , Format(..) -- ** Errors , LastfmError(..) , _LastfmBadResponse , _LastfmEncodedError , _LastfmHttpError - -- ** Internal - , lastfmWith - , finalize #ifdef TEST , parse , md5 @@ -47,8 +46,8 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Read as T import Data.Typeable (Typeable, cast) -import qualified Network.HTTP.Client as N -import qualified Network.HTTP.Client.TLS as N +import qualified Network.HTTP.Client as Http +import qualified Network.HTTP.Client.TLS as Http import Text.XML (Document, parseLBS, def) import Text.XML.Cursor @@ -115,7 +114,7 @@ -- | last.fm error code and message string | LastfmEncodedError Int Text -- | wrapped http-conduit exception - | LastfmHttpError N.HttpException + | LastfmHttpError Http.HttpException deriving (Show, Typeable) -- | Admittedly, this isn't the best 'Eq' instance ever @@ -165,7 +164,7 @@ -- | This is a @ Prism' 'LastfmError' 'C.HttpException' @ in disguise _LastfmHttpError :: (Choice p, Applicative m, AsLastfmError e) - => p N.HttpException (m N.HttpException) -> p e (m e) + => p Http.HttpException (m Http.HttpException) -> p e (m e) _LastfmHttpError = _LastfmError . dimap go (either pure (fmap LastfmHttpError)) . right' where go (LastfmHttpError e) = Right e go x = Left x @@ -202,27 +201,36 @@ md5 = T.pack . show . (hash' :: Strict.ByteString -> MD5Digest) . T.encodeUtf8 --- | Send the 'Request' and parse the 'Response' -lastfm :: Supported f r => Request f Ready -> IO (Either LastfmError r) -lastfm = lastfmWith parse . finalize +-- | Lastfm connection manager +newtype Connection = Connection Http.Manager --- | Send the 'Request' without parsing the 'Response' -lastfm_ :: Supported f r => Request f Ready -> IO (Either LastfmError ()) -lastfm_ = lastfmWith (\_ -> Right ()) . finalize +-- | Creating an HTTPS connection manager is expensive; it's advised to use +-- a single 'Connection' for all communications with last.fm +withConnection :: (Connection -> IO a) -> IO a +withConnection f = Http.withManager Http.tlsManagerSettings (f . Connection) +-- | Perform the 'Request' and parse the response +lastfm :: Supported f r => Connection -> Request f Ready -> IO (Either LastfmError r) +lastfm man = lastfmWith man parse . finalize + +-- | Perform the 'Request' ignoring any responses +lastfm_ :: Supported f r => Connection -> Request f Ready -> IO (Either LastfmError ()) +lastfm_ man = lastfmWith man (\_ -> Right ()) . finalize + -- | Send the 'R' and parse the 'Response' with the supplied parser lastfmWith :: Supported f r - => (Lazy.ByteString -> Either LastfmError a) + => Connection + -> (Lazy.ByteString -> Either LastfmError a) -> R f -> IO (Either LastfmError a) -lastfmWith p r = N.withManager N.tlsManagerSettings $ \manager -> do - req <- N.parseUrl (render r) +lastfmWith (Connection man) p r = do + req <- Http.parseUrl (render r) let req' = req - { N.method = _method r - , N.responseTimeout = Just 10000000 + { Http.method = _method r + , Http.responseTimeout = Just 10000000 } - p . N.responseBody <$> N.httpLbs req' manager + p . Http.responseBody <$> Http.httpLbs req' man `catch` (return . Left) diff --git a/test/api/Json/PlaylistSpec.hs b/test/api/Json/PlaylistSpec.hs --- a/test/api/Json/PlaylistSpec.hs +++ b/test/api/Json/PlaylistSpec.hs @@ -26,7 +26,7 @@ key "playlists".key "playlist".key "title"._String it "addTrack" $ do - r <- lastfm $ getPlaylists <*> user "liblastfm" <*> ak' <* json + r <- lastfm man $ getPlaylists <*> user "liblastfm" <*> ak' <* json case r of Left e -> assertFailure (printf "last.fm error: %s" (show e)) diff --git a/test/api/SpecHelper.hs b/test/api/SpecHelper.hs --- a/test/api/SpecHelper.hs +++ b/test/api/SpecHelper.hs @@ -21,21 +21,26 @@ , privateAPIKey , privateSessionKey , privateSecret + -- $really-awful + , man ) where -import Control.Exception (Exception, throwIO) -import Control.Lens -import Data.Aeson (Value) -import Data.Aeson.Lens -import Data.Text (Text, pack) -import Data.Typeable (Typeable) -import Network.Lastfm -import System.Environment -import System.IO.Unsafe (unsafePerformIO) -import Test.Hspec -import Test.HUnit (assertFailure) -import Text.Printf -import Text.Xml.Lens +import Control.Exception (Exception, throwIO) +import Control.Lens +import Data.Aeson (Value) +import Data.Aeson.Lens +import Data.Text (Text, pack) +import Data.Typeable (Typeable) +import qualified Network.HTTP.Client as Http +import qualified Network.HTTP.Client.TLS as Http +import Network.Lastfm +import System.Environment +import System.IO.Unsafe (unsafePerformIO) +import Test.Hspec +import Test.HUnit (assertFailure) +import Text.Printf +import Text.Xml.Lens +import Unsafe.Coerce (unsafeCoerce) infixl 1 `shouldHaveJson`, `shouldHaveXml` @@ -43,7 +48,7 @@ -- | Inspect 'Response' with 'Query' shouldHaveResponse :: (Show r, Supported f r) => Request f Ready -> Fold r a -> Expectation shouldHaveResponse q l = do - r <- lastfm q + r <- lastfm man q case preview (_Right.l) r of Just _ -> return () Nothing -> assertFailure (printf "Query failed on %s" (show r)) @@ -96,3 +101,8 @@ case mv of Just v -> return (pack v) Nothing -> throwIO (EnvironmentMissing var) + +-- $really-awful + +man :: Connection +man = unsafeCoerce (unsafePerformIO (Http.newManager Http.tlsManagerSettings)) diff --git a/test/api/Xml/PlaylistSpec.hs b/test/api/Xml/PlaylistSpec.hs --- a/test/api/Xml/PlaylistSpec.hs +++ b/test/api/Xml/PlaylistSpec.hs @@ -25,7 +25,7 @@ root.node "playlists".node "playlist".node "title".text it "addTrack" $ do - r <- lastfm $ getPlaylists <*> user "liblastfm" <*> ak' <* Network.Lastfm.xml + r <- lastfm man $ getPlaylists <*> user "liblastfm" <*> ak' <* Network.Lastfm.xml case r of Left e -> assertFailure (printf "last.fm error: %s" (show e))