diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,13 +1,21 @@ +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 ======= - * Fix `auth.getMobileSession` method - * Provide `lastfm_` function for making requests without parsing response. That is most useful for `POST` requests like `N.L.Track.love` + * 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 ======= - * Support batch operations for `N.L.Track.scrobble`, `N.L.Library.{addAlbum,addArtist}` + * Supported batch operations for `N.L.Track.scrobble`, `N.L.Library.{addAlbum,addArtist}` 0.2.0.0 ======= diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (C) 2012 Matvey Aksenov, Dmitry Malikov +Copyright (C) 2012-2014 Matvey Aksenov, Dmitry Malikov Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,25 +1,35 @@ -# liblastfm -[![Hackage](https://budueba.com/hackage/liblastfm)](http://hackage.haskell.org/package/liblastfm) +liblastfm +========= +[![Hackage](https://budueba.com/hackage/liblastfm)](https://hackage.haskell.org/package/liblastfm) [![Build Status](https://drone.io/github.com/supki/liblastfm/status.png)](https://drone.io/github.com/supki/liblastfm/latest) -[![Build Status](https://secure.travis-ci.org/supki/liblastfm.png?branch=develop)](http://travis-ci.org/supki/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][1] service. +Complete API interface to [last.fm][last.fm] service. Documentation is available in two flavours: - * original [API reference][2] - * liblastfm [haddocks][3] -## General introduction + * 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][4] + + * [signing][last.fm/sign] + * url-encoding + * miscellaneous stuff like choosing correct HTTP method, etc -Once request is ready, liblastfm may send it and get you back a response. +Once request is ready, liblastfm can send it and get you back a response. Response format might be: - * `Maybe Value` from [aeson][5] for json queries (nice interaction with [aeson-lens][6] for free!) - * raw `ByteString` for xml queries -## Installation + * [aeson][aeson] `Value` for json queries + + * [xml-conduit][xml-conduit] `Document` for xml queries + +Installation +------------ To install either use hackage: % cabal install liblastfm @@ -30,13 +40,14 @@ % cd liblastfm % cabal install -## Usage -Suppose, you need to use [`tag.search`](http://www.last.fm/api/show/tag.search) 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][7]. +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: - ghci> import Network.Lastfm -- a bunch of useful utilities - ghci> import qualified Network.Lastfm.Tag as Tag -- for Tag.search + >>> 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: @@ -45,57 +56,73 @@ To send constructed request use `lastfm`: - ghci> lastfm $ Tag.search <*> tag "russian-folk" <* limit 10 <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json + >>> lastfm $ Tag.search <*> tag "russian-folk" <* limit 10 <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json Just (Object fromList [("results",Object fromList [("tagmatches", ... -How to parse responses is described [in wiki][8]. +[Wiki][liblastfm/wiki] describes how to parse responses. -## FAQ +FAQ +--- + **Q: I'm getting the following error. How do I fix it?** + ``` -> Artist.getInfo <*> artist "Pink Floyd" <*> apiKey "29effec263316a1f8a97f753caaa83e0" +>>> 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") +>>> lastfm (Artist.getInfo <*> artist "Pink Floyd" <*> apiKey "29effec263316a1f8a97f753caaa83e0") :13:1: - No instance for (Network.Lastfm.Response.Supported f0) - arising from a use of `lastfm' - The type variable `f0' is ambiguous - Possible fix: add a type signature that fixes these type variable(s) - Note: there are several potential instances: - instance Network.Lastfm.Response.Supported 'XML - -- Defined at src/Network/Lastfm/Response.hs:66:10 - instance Network.Lastfm.Response.Supported 'JSON - -- Defined at src/Network/Lastfm/Response.hs:51:10 + 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 `Request`. + +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 -``` -> lastfm (Artist.getInfo <*> artist "Pink Floyd" <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json) -Just (Object fromList [("artist" ... -> lastfm (Artist.getInfo <*> artist "Pink Floyd" <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* xml) -" 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 new file mode 100644 --- /dev/null +++ b/examples/liblastfm-examples.cabal @@ -0,0 +1,99 @@ +name: liblastfm-examples +version: 0.4.0.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.0 + 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.0 + , 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.0 + , 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.0 + 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.0 + , 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.0 + 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.0 + main-is: recommendations.hs + ghc-options: -Wall + -fno-warn-unused-do-bind diff --git a/examples/mobile-authentication.hs b/examples/mobile-authentication.hs new file mode 100644 --- /dev/null +++ b/examples/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 +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 new file mode 100644 --- /dev/null +++ b/examples/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 + - 坂本真綾 + - 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 new file mode 100644 --- /dev/null +++ b/examples/playcount.hs @@ -0,0 +1,31 @@ +{-# 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 +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 new file mode 100644 --- /dev/null +++ b/examples/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 +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 new file mode 100644 --- /dev/null +++ b/examples/sort-friends.hs @@ -0,0 +1,73 @@ +{-# 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 +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 new file mode 100644 --- /dev/null +++ b/examples/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 +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.3.2.0 +version: 0.4.0.0 synopsis: Lastfm API interface license: MIT license-file: LICENSE @@ -13,30 +13,46 @@ 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 source-repository head type: git location: https://github.com/supki/liblastfm +flag test-api + description: a real API test + default: False + manual: True + library default-language: Haskell2010 build-depends: aeson - , base >= 3 && < 5 + , base >= 4 && < 5 , bytestring , cereal - , containers >= 0.5 + , containers >= 0.5 , contravariant , crypto-api - , http-conduit >= 1.9 - , http-types + , http-client >= 0.3 + , http-client-tls >= 0.2 , network + , profunctors , pureMD5 , semigroups - , tagged , text , void - hs-source-dirs: src + , xml-conduit >= 1.1 + hs-source-dirs: + src exposed-modules: Network.Lastfm Network.Lastfm.Album @@ -61,3 +77,88 @@ -Wall -fno-warn-unused-do-bind -funbox-strict-fields + +test-suite api + if !flag(test-api) + buildable: False + default-language: Haskell2010 + build-depends: + aeson + , base >= 4 && < 5 + , bytestring + , HUnit + , lens >= 4.0.1 + , liblastfm + , hspec + , text + , xml-html-conduit-lens >= 0.3 + type: exitcode-stdio-1.0 + hs-source-dirs: + test/api + main-is: Spec.hs + other-modules: + SpecHelper + Json.AlbumSpec + Json.ArtistSpec + Json.ChartSpec + Json.EventSpec + Json.GeoSpec + Json.GroupSpec + Json.LibrarySpec + Json.PlaylistSpec + Json.TagSpec + Json.TasteometerSpec + Json.TrackSpec + Json.UserSpec + Json.VenueSpec + Xml.AlbumSpec + Xml.ArtistSpec + Xml.ChartSpec + Xml.EventSpec + Xml.GeoSpec + Xml.GroupSpec + Xml.LibrarySpec + Xml.PlaylistSpec + Xml.TagSpec + Xml.TasteometerSpec + Xml.TrackSpec + Xml.UserSpec + Xml.VenueSpec + ghc-options: + -Wall + -fno-warn-orphans + -fno-warn-unused-do-bind + +test-suite spec + default-language: Haskell2010 + build-depends: + aeson + , base >= 4 && < 5 + , bytestring + , cereal + , containers + , contravariant + , crypto-api + , hspec + , hspec-expectations-lens >= 0.3.0.0 + , http-client + , http-client-tls + , lens >= 4.0 + , network + , profunctors + , pureMD5 + , text + , void + , xml-conduit + , xml-html-conduit-lens >= 0.3 + type: exitcode-stdio-1.0 + hs-source-dirs: + src + test/spec + main-is: Spec.hs + other-modules: + Network.Lastfm.ResponseSpec + ghc-options: + -Wall + cpp-options: + -DTEST diff --git a/src/Network/Lastfm/Internal.hs b/src/Network/Lastfm/Internal.hs --- a/src/Network/Lastfm/Internal.hs +++ b/src/Network/Lastfm/Internal.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE AutoDeriveTypeable #-} +#endif {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE KindSignatures #-} @@ -5,26 +9,35 @@ -- -- You shouldn't need to import this module unless you are doing something interesting. module Network.Lastfm.Internal - ( Request(..), Format(..), Ready, Sign - , R(..), wrap, unwrap, render, coerce - , absorbQuery, indexedWith + ( Request(..) + , Format(..) + , Ready + , Sign + , R(..) + , wrap + , unwrap + , render + , coerce + , absorbQuery + , indexedWith -- * Lenses - , host, method, query + , host + , method + , query ) where -import Control.Applicative -import Data.Foldable (Foldable(..)) -import Data.Monoid -import Data.Traversable (Traversable(..)) - +import Control.Applicative import Data.ByteString (ByteString) +import Data.Foldable (Foldable(..)) import Data.Functor.Contravariant (Contravariant(..)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M +import Data.Monoid import Data.Serialize (Serialize(..)) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T +import Data.Traversable (Traversable(..)) import Data.Void (absurd) import Network.URI (escapeURIChar, isUnreserved) @@ -50,11 +63,10 @@ -- | Lastfm API request data type -- --- @a@ is authentication state. Might be 'Send' which indicates --- that you may send this request already or 'Sign', when request signature --- isn't computed yet +-- @a@ is the authentication state. Can be 'Ready', which means this 'Request' is +-- ready to be sent, or 'Sign', if the request signature hasn't been computed yet -- --- @f@ is response format. liblastfm currently supports 'JSON' or 'XML' +-- @f@ is the response format (liblastfm supports both 'JSON' and 'XML') newtype Request f a = Request { unRequest :: Const (Dual (Endo (R f))) a } instance Functor (Request f) where @@ -130,16 +142,16 @@ put r = do put $ T.encodeUtf8 (_host r) put $ _method r - put $ mapmap T.encodeUtf8 T.encodeUtf8 (_query r) + put $ bimap T.encodeUtf8 T.encodeUtf8 (_query r) get = do h <- T.decodeUtf8 <$> get m <- get - q <- mapmap T.decodeUtf8 T.decodeUtf8 <$> get + q <- bimap T.decodeUtf8 T.decodeUtf8 <$> get return R { _host = h, _method = m, _query = q } -mapmap :: (Ord s, Ord t) => (s -> t) -> (a -> b) -> Map s a -> Map t b -mapmap f g = M.mapKeys f . M.map g -{-# INLINE mapmap #-} +bimap :: (Ord s, Ord t) => (s -> t) -> (a -> b) -> Map s a -> Map t b +bimap f g = M.mapKeys f . M.map g +{-# INLINE bimap #-} -- | 'Request' '_host' 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 @@ -1,136 +1,231 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} -- | Request sending and Response parsing module Network.Lastfm.Response - ( -- * Sign Request + ( -- * Compute request signature -- $sign - Secret(..), sign - -- * Get 'Response' - , Response, Supported, lastfm, lastfm_ + Secret(..) + , sign + -- * Get response + , Supported + , Format(..) + , lastfm + , lastfm_ + -- ** Errors + , LastfmError(..) + , _LastfmBadResponse + , _LastfmEncodedError + , _LastfmHttpError -- ** Internal - , lastfm', finalize + , lastfmWith + , finalize +#ifdef TEST + , parse + , md5 +#endif ) where -import Control.Applicative -import Control.Exception (throw) -import Control.Monad -import Data.Monoid -import Data.String (IsString(..)) -import Data.Proxy (Proxy(..)) - +import Control.Applicative +import Control.Exception (SomeException(..), Exception(..), catch) import Crypto.Classes (hash') -import Data.Aeson ((.:), Value, decode, parseJSON) +import Data.Aeson ((.:), Value(..), decode) import Data.Aeson.Types (parseMaybe) import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString as Strict import Data.Digest.Pure.MD5 (MD5Digest) import Data.Map (Map) import qualified Data.Map as M +import Data.Monoid +import Data.Profunctor (Choice, dimap, right') +import Data.String (IsString(..)) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T -import qualified Network.HTTP.Conduit as C -import qualified Network.HTTP.Types as C +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 Text.XML (Document, parseLBS, def) +import Text.XML.Cursor -import Network.Lastfm.Internal +import Network.Lastfm.Internal -- $sign -- --- Signing is important part of every --- authentication requiring API request. --- Basically, every such request is appended --- with md5 footprint of its arguments as +-- The signature is required for every +-- authenticated API request. Basically, +-- every such request appends the md5 footprint +-- of its arguments to the query as -- described at --- | 'Supported' provides parsing for a chosen 'Format' +-- | 'Supported' provides parsing for the chosen 'Format' -- --- 'JSON' is parsed to aeson's 'Value', 'XML' is to lazy 'ByteString' --- (in other words, parsing XML is left to the user) -class Supported (f :: Format) where - type Response f - parse :: proxy f -> Lazy.ByteString -> C.ResponseHeaders -> Response f - base :: R f +-- 'JSON' is parsed to 'Value' type from aeson, while 'XML' +-- is parsed to 'Document' from xml-conduit +class Supported f r | f -> r, r -> f where + prepareRequest :: R f -> R f + parseResponseBody :: Lazy.ByteString -> Maybe r + parseResponseEncodedError :: r -> Maybe LastfmError +instance Supported JSON Value where + prepareRequest r = r { _query = M.singleton "format" "json" `M.union` _query r } + parseResponseBody = decode + parseResponseEncodedError = parseMaybe $ \(Object o) -> do + code <- o .: "error" + msg <- o .: "message" + return (LastfmEncodedError code msg) -instance Supported JSON where - type Response JSON = Maybe Value - parse _ b hs = do - v <- decode b - case parseMaybe ((.: "error") <=< parseJSON) v :: Maybe Int of - Just _ -> - throw (C.StatusCodeException C.status400 (("Response", Strict.concat $ Lazy.toChunks b) : hs) (C.createCookieJar [])) - _ -> return v - base = R - { _host = "https://ws.audioscrobbler.com/2.0/" - , _method = "GET" - , _query = M.fromList [("format", "json")] - } - {-# INLINE base #-} +instance Supported XML Document where + prepareRequest = id + parseResponseBody = either (const Nothing) Just . parseLBS def + parseResponseEncodedError doc = case fromDocument doc of + cur + | [mcode] <- cur $| element "lfm" >=> child >=> element "error" >=> attribute "code" + , Right (code, _) <- T.decimal mcode + , [msg] <- cur $| element "lfm" >=> child >=> element "error" >=> child >=> content + -> Just (LastfmEncodedError code (T.strip msg)) + | + otherwise -> Nothing -instance Supported XML where - type Response XML = Lazy.ByteString - parse _ b _ = b - {-# INLINE parse #-} - base = R - { _host = "https://ws.audioscrobbler.com/2.0/" - , _method = "GET" - , _query = mempty - } - {-# INLINE base #-} +parse :: Supported f r => Lazy.ByteString -> Either LastfmError r +parse body = case parseResponseBody body of + Just v + | Just e <- parseResponseEncodedError v -> Left e + | otherwise -> Right v + Nothing -> Left (LastfmBadResponse body) +base :: R f +base = R + { _host = "https://ws.audioscrobbler.com/2.0/" + , _method = "GET" + , _query = mempty + } + +-- | Different ways last.fm response can be unusable +data LastfmError = + -- | last.fm thinks it responded with something legible, but it really isn't + LastfmBadResponse Lazy.ByteString + -- | last.fm error code and message string + | LastfmEncodedError Int Text + -- | wrapped http-conduit exception + | LastfmHttpError N.HttpException + deriving (Show, Typeable) + +-- | Admittedly, this isn't the best 'Eq' instance ever +-- but not having 'Eq' 'C.HttpException' does not leave much a choice +instance Eq LastfmError where + LastfmBadResponse bs == LastfmBadResponse bs' = bs == bs' + LastfmEncodedError e s == LastfmEncodedError e' t = e == e' && s == t + LastfmHttpError _ == LastfmHttpError _ = True + _ == _ = False + +instance Exception LastfmError where + fromException e@(SomeException se) + | Just e' <- fromException e = Just (LastfmHttpError e') + | otherwise = cast se + +class AsLastfmError t where + _LastfmError :: (Choice p, Applicative m) => p LastfmError (m LastfmError) -> p t (m t) + +instance AsLastfmError LastfmError where + _LastfmError = id + {-# INLINE _LastfmError #-} + +instance AsLastfmError SomeException where + _LastfmError = dimap (\e -> maybe (Left e) Right (fromException e)) (either pure (fmap toException)) . right' + {-# INLINE _LastfmError #-} + +-- | This is a @ Prism' 'LastfmError' 'Lazy.ByteString' @ in disguise +_LastfmBadResponse + :: (Choice p, Applicative m, AsLastfmError e) + => p Lazy.ByteString (m Lazy.ByteString) -> p e (m e) +_LastfmBadResponse = _LastfmError . dimap go (either pure (fmap LastfmBadResponse)) . right' where + go (LastfmBadResponse bs) = Right bs + go x = Left x + {-# INLINE go #-} +{-# INLINE _LastfmBadResponse #-} + +-- | This is a @ Prism' 'LastfmError' ('Int', 'String') @ in disguise +_LastfmEncodedError + :: (Choice p, Applicative m, AsLastfmError e) + => p (Int, Text) (m (Int, Text)) -> p e (m e) +_LastfmEncodedError = _LastfmError . dimap go (either pure (fmap (uncurry LastfmEncodedError))) . right' where + go (LastfmEncodedError n v) = Right (n, v) + go x = Left x + {-# INLINE go #-} +{-# INLINE _LastfmEncodedError #-} + +-- | 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) +_LastfmHttpError = _LastfmError . dimap go (either pure (fmap LastfmHttpError)) . right' where + go (LastfmHttpError e) = Right e + go x = Left x + {-# INLINE go #-} +{-# INLINE _LastfmHttpError #-} + + -- | Application secret -newtype Secret = Secret Text deriving (Show) +newtype Secret = Secret Text deriving (Show, Eq, Typeable) instance IsString Secret where fromString = Secret . fromString --- | Sign 'Request' with 'Secret' +-- | Sign the 'Request' with the 'Secret' so it's ready to be sent sign :: Secret -> Request f Sign -> Request f Ready sign s = coerce . (<* signature) where signature = wrap $ - \r@R { _query = q } -> r { _query = api_sig s . authToken $ q } + \r@R { _query = q } -> r { _query = apiSig s . authToken $ q } authToken :: Map Text Text -> Map Text Text authToken q = maybe q (M.delete "password") $ do password <- M.lookup "password" q username <- M.lookup "username" q - return (M.insert "authToken" (md5 (username <> (md5 password))) q) + return (M.insert "authToken" (md5 (username <> md5 password)) q) -api_sig :: Secret -> Map Text Text -> Map Text Text -api_sig (Secret s) q = M.insert "api_sig" (signer (foldr M.delete q ["format", "callback"])) q +apiSig :: Secret -> Map Text Text -> Map Text Text +apiSig (Secret s) q = M.insert "api_sig" (signer (foldr M.delete q ["format", "callback"])) q where - signer = md5 . M.foldrWithKey(\k v xs -> k <> v <> xs) s + signer = md5 . M.foldrWithKey (\k v xs -> k <> v <> xs) s +-- | Get supplied string md5 hash hex representation md5 :: Text -> Text md5 = T.pack . show . (hash' :: Strict.ByteString -> MD5Digest) . T.encodeUtf8 --- | Send 'Request' and parse the 'Response' -lastfm :: Supported f => Request f Ready -> IO (Response f) -lastfm = lastfm' parse . finalize - --- | Send 'Request' without parsing the 'Response' -lastfm_ :: Supported f => Request f Ready -> IO () -lastfm_ = lastfm' (\_ _ _ -> ()) . finalize - - --- | Get 'R' from 'Request' -finalize :: Supported f => Request f Ready -> R f -finalize = ($ base) . unwrap +-- | Send the 'Request' and parse the 'Response' +lastfm :: Supported f r => Request f Ready -> IO (Either LastfmError r) +lastfm = lastfmWith parse . finalize +-- | Send the 'Request' without parsing the 'Response' +lastfm_ :: Supported f r => Request f Ready -> IO (Either LastfmError ()) +lastfm_ = lastfmWith (\_ -> Right ()) . finalize --- | Send 'R' and parse 'Response' with the supplied function -lastfm' :: Supported f => (Proxy f -> Lazy.ByteString -> C.ResponseHeaders -> a) -> R f -> IO a -lastfm' f request = C.withManager $ \manager -> do - req <- C.parseUrl (render request) +-- | Send the 'R' and parse the 'Response' with the supplied parser +lastfmWith + :: Supported f r + => (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) let req' = req - { C.method = _method request - , C.responseTimeout = Just 10000000 + { N.method = _method r + , N.responseTimeout = Just 10000000 } - res <- C.httpLbs req' manager - return $ f Proxy (C.responseBody res) (C.responseHeaders res) + p . N.responseBody <$> N.httpLbs req' manager + `catch` + (return . Left) + +-- | Get the 'R' from the 'Request' +finalize :: Supported f r => Request f Ready -> R f +finalize x = (prepareRequest . unwrap x) base diff --git a/test/api/Json/AlbumSpec.hs b/test/api/Json/AlbumSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/AlbumSpec.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.AlbumSpec (spec) where + +import Data.Aeson (Value) +import Data.Aeson.Lens +import Data.Text (Text) +import Network.Lastfm +import Network.Lastfm.Album +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + it "addTags" $ + shouldHaveJson_ . privately $ + addTags <*> artist "Pink Floyd" <*> album "The Wall" <*> tags ["70s", "awesome", "classic"] + + it "getTags-authenticated" $ + privately (getTags <*> artist "Pink Floyd" <*> album "The Wall") + `shouldHaveJson` + key "tags".key "tag".values.key "name"._String + + it "removeTag" $ + shouldHaveJson_ . privately $ + removeTag <*> artist "Pink Floyd" <*> album "The Wall" <*> tag "awesome" + + it "share" $ + shouldHaveJson_ . privately $ + share <*> album "Jerusalem" <*> artist "Sleep" <*> recipient "liblastfm" <* message "Just listen!" + + describe "getBuyLinks*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "affiliations".key "physicals".key "affiliation".values.key "supplierName"._String + + it "getBuyLinks" $ + publicly (getBuyLinks <*> country "United Kingdom" <*> artist "Pink Floyd" <*> album "The Wall") + `shouldHaveJson` + jsonQuery + + it "getBuyLinks_mbid" $ + publicly (getBuyLinks <*> country "United Kingdom" <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34") + `shouldHaveJson` + jsonQuery + + describe "getInfo*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "album".key "toptags".key "tag".values.key "name"._String + + it "getInfo" $ + publicly (getInfo <*> artist "Pink Floyd" <*> album "The Wall") + `shouldHaveJson` + jsonQuery + + it "getInfo_mbid" $ + publicly (getInfo <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34") + `shouldHaveJson` + jsonQuery + + describe "getShouts*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "shouts".key "shout".values.key "body"._String + + it "getShouts" $ + publicly (getShouts <*> artist "Pink Floyd" <*> album "The Wall" <* limit 7) + `shouldHaveJson` + jsonQuery + + it "getShouts_mbid" $ + publicly (getShouts <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34" <* limit 7) + `shouldHaveJson` + jsonQuery + + describe "getTags*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "tags".key "tag".values.key "name"._String + + it "getTags" $ + publicly (getTags <*> artist "Pink Floyd" <*> album "The Wall" <* user "liblastfm") + `shouldHaveJson` + jsonQuery + + it "getTags_mbid" $ + publicly (getTags <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34" <* user "liblastfm") + `shouldHaveJson` + jsonQuery + + describe "getTopTags*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "toptags".key "tag".values.key "count"._String + + it "getTopTags" $ + publicly (getTopTags <*> artist "Pink Floyd" <*> album "The Wall") + `shouldHaveJson` + jsonQuery + + it "getTopTags_mbid" $ + publicly (getTopTags <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34") + `shouldHaveJson` + jsonQuery + + it "search" $ + publicly (search <*> album "wall" <* limit 5) + `shouldHaveJson` + key "results".key "albummatches".key "album".values.key "name"._String diff --git a/test/api/Json/ArtistSpec.hs b/test/api/Json/ArtistSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/ArtistSpec.hs @@ -0,0 +1,196 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.ArtistSpec (spec) where + +import Data.Aeson (Value) +import Data.Aeson.Lens +import Data.Text (Text) +import Network.Lastfm +import Network.Lastfm.Artist +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do +  it "addTags" $ +   shouldHaveJson_ . privately $ +     addTags <*> artist "Егор Летов" <*> tags ["russian", "black metal"] + +  it "getTags-authenticated" $ + privately (getTags <*> artist "Егор Летов") + `shouldHaveJson` +   key "tags".key "tag".values.key "name"._String + +  it "removeTag" $ +   shouldHaveJson_ . privately $ + removeTag <*> artist "Егор Летов" <*> tag "russian" + +  it "share" $ +   shouldHaveJson_ . privately $ + share <*> artist "Sleep" <*> recipient "liblastfm" <* message "Just listen!" + +  it "getCorrection" $ +   publicly (getCorrection <*> artist "Meshugah") + `shouldHaveJson` +   key "corrections".key "correction".key "artist".key "name"._String + + describe "getEvents*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "events".key "artist"._String + +   it "getEvents" $ +     publicly (getEvents <*> artist "Meshuggah" <* limit 2) + `shouldHaveJson` +   jsonQuery + +   it "getEvents_mbid" $ +     publicly (getEvents <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 2) + `shouldHaveJson` +   jsonQuery + + describe "getInfo*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "artist".key "stats".key "listeners"._String + +   it "getInfo" $ +     publicly (getInfo <*> artist "Meshuggah") + `shouldHaveJson` +   jsonQuery + +   it "getInfo_mbid" $ +     publicly (getInfo <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413") + `shouldHaveJson` +   jsonQuery + + describe "getPastEvents*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "events".key "event".values.key "title"._String + +   it "getPastEvents" $ + publicly (getPastEvents <*> artist "Meshuggah" <* autocorrect True) + `shouldHaveJson` +   jsonQuery + +   it "getPastEvents_mbid" $ + publicly (getPastEvents <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* autocorrect True) + `shouldHaveJson` +   jsonQuery + + describe "getPodcast*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "rss".key "channel".key "description"._String + +   it "getPodcast" $ +     publicly (getPodcast <*> artist "Meshuggah") + `shouldHaveJson` +   jsonQuery + +   it "getPodcast_mbid" $ +     publicly (getPodcast <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413") + `shouldHaveJson` +   jsonQuery + + describe "getShouts*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "shouts".key "shout".values.key "author"._String + +   it "getShouts" $ +     publicly (getShouts <*> artist "Meshuggah" <* limit 5) + `shouldHaveJson` +   jsonQuery + +   it "getShouts_mbid" $ +     publicly (getShouts <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 5) + `shouldHaveJson` +   jsonQuery + + describe "getSimilar*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "similarartists".key "artist".values.key "name"._String + +   it "getSimilar" $ +     publicly (getSimilar <*> artist "Meshuggah" <* limit 3) + `shouldHaveJson` +   jsonQuery + +   it "getSimilar_mbid" $ +     publicly (getSimilar <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 3) + `shouldHaveJson` +   jsonQuery + + describe "getTags*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "tags".key "tag".values.key "name"._String + +   it "getTags" $ +     publicly (getTags <*> artist "Егор Летов" <* user "liblastfm") + `shouldHaveJson` +   jsonQuery + +   it "getTags_mbid" $ +     publicly (getTags <*> mbid "cfb3d32e-d095-4d63-946d-9daf06932180" <* user "liblastfm") + `shouldHaveJson` +   jsonQuery + + describe "getTopAlbums*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "topalbums".key "album".values.key "name"._String + +   it "getTopAlbums" $ +     publicly (getTopAlbums <*> artist "Meshuggah" <* limit 3) + `shouldHaveJson` +   jsonQuery + +   it "getTopAlbums_mbid" $ +     publicly (getTopAlbums <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 3) + `shouldHaveJson` +   jsonQuery + + describe "getTopFans*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "topfans".key "user".values.key "name"._String + +   it "getTopFans" $ +     publicly (getTopFans <*> artist "Meshuggah") + `shouldHaveJson` +   jsonQuery + +   it "getTopFans_mbid" $ +     publicly (getTopFans <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413") + `shouldHaveJson` +   jsonQuery + + describe "getTopTags*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "toptags".key "tag".values.key "name"._String + +   it "getTopTags" $ +     publicly (getTopTags <*> artist "Meshuggah") + `shouldHaveJson` +   jsonQuery + +   it "getTopTags_mbid" $ +     publicly (getTopTags <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413") + `shouldHaveJson` +   jsonQuery + + describe "getTopTracks*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "toptracks".key "track".values.key "name"._String + +   it "getTopTracks" $ +     publicly (getTopTracks <*> artist "Meshuggah" <* limit 3) + `shouldHaveJson` +   jsonQuery + +   it "getTopTracks_mbid" $ +     publicly (getTopTracks <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 3) + `shouldHaveJson` +   jsonQuery + +  it "search" $ + publicly (search <*> artist "Mesh" <* limit 3) + `shouldHaveJson` +   key "results".key "artistmatches".key "artist".values.key "name"._String diff --git a/test/api/Json/ChartSpec.hs b/test/api/Json/ChartSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/ChartSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.ChartSpec (spec) where + +import Data.Aeson (Value) +import Data.Aeson.Lens +import Data.Text (Text) +import Network.Lastfm +import Network.Lastfm.Chart +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + describe "get*Artists" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "artists".key "artist".values.key "name"._String + + it "getHypedArtists" $ + publicly (getHypedArtists <* limit 3) + `shouldHaveJson` + jsonQuery + + it "getTopArtists" $ + publicly (getTopArtists <* limit 4) + `shouldHaveJson` + jsonQuery + + describe "get*Tracks" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "tracks".key "track".values.key "name"._String + + it "getHypedTracks" $ + publicly (getHypedTracks <* limit 2) + `shouldHaveJson` + jsonQuery + + it "getLovedTracks" $ + publicly (getLovedTracks <* limit 3) + `shouldHaveJson` + jsonQuery + + it "getTopTracks" $ + publicly (getTopTracks <* limit 2) + `shouldHaveJson` + jsonQuery + + it "getTopTags" $ + publicly (getTopTags <* limit 5) + `shouldHaveJson` + key "tags".key "tag".values.key "name"._String diff --git a/test/api/Json/EventSpec.hs b/test/api/Json/EventSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/EventSpec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.EventSpec (spec) where + +import Data.Aeson.Lens +import Network.Lastfm +import Network.Lastfm.Event +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + it "attend" $ + shouldHaveJson_ . privately $ + attend <*> event 3142549 <*> status Attending + + it "share" $ + shouldHaveJson_ . privately $ + share <*> event 3142549 <*> recipient "liblastfm" <* message "Just listen!" + + it "getAttendees" $ + publicly (getAttendees <*> event 3142549 <* limit 2) + `shouldHaveJson` + key "attendees".key "user".values.key "name"._String + + it "getInfo" $ + publicly (getInfo <*> event 3142549) + `shouldHaveJson` + key "event".key "venue".key "location".key "city"._String + + it "getShouts" $ + publicly (getShouts <*> event 3142549 <* limit 1) + `shouldHaveJson` + key "shouts".key "shout".key "body"._String diff --git a/test/api/Json/GeoSpec.hs b/test/api/Json/GeoSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/GeoSpec.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.GeoSpec (spec) where + +import Data.Aeson (Value) +import Data.Aeson.Lens +import Data.Text (Text) +import Network.Lastfm +import Network.Lastfm.Geo +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + it "getEvents" $ + publicly (getEvents <* location "Moscow" <* limit 5) + `shouldHaveJson` + key "events".key "event".values.key "id"._String + + describe "get*Artist*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "topartists".key "artist".values.key "name"._String + + it "getMetroArtistChart" $ + publicly (getMetroArtistChart <*> metro "Saint Petersburg" <*> country "Russia") + `shouldHaveJson` + jsonQuery + + it "getMetroHypeArtistChart" $ + publicly (getMetroHypeArtistChart <*> metro "New York" <*> country "United States") + `shouldHaveJson` + jsonQuery + + it "getMetroUniqueArtistChart" $ + publicly (getMetroUniqueArtistChart <*> metro "Minsk" <*> country "Belarus") + `shouldHaveJson` + jsonQuery + + it "getTopArtists" $ + publicly (getTopArtists <*> country "Belarus" <* limit 3) + `shouldHaveJson` + jsonQuery + + it "getMetroWeeklyChartlist" $ + publicly (getMetroWeeklyChartlist <*> metro "Moscow") + `shouldHaveJson` + key "weeklychartlist".key "chart".values.key "from"._String + + it "getMetros" $ + publicly (getMetros <* country "Russia") + `shouldHaveJson` + key "metros".key "metro".values.key "name"._String + + describe "get*Track*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "toptracks".key "track".values.key "name"._String + + it "getTopTracks" $ + publicly (getTopTracks <*> country "Ukraine" <* limit 2) + `shouldHaveJson` + jsonQuery + + it "getMetroUniqueTrackChart" $ + publicly (getMetroUniqueTrackChart <*> metro "Moscow" <*> country "Russia") + `shouldHaveJson` + jsonQuery + + it "getMetroHypeTrackChart" $ + publicly (getMetroHypeTrackChart <*> metro "Moscow" <*> country "Russia") + `shouldHaveJson` + jsonQuery + + it "getMetroTrackChart" $ + publicly (getMetroTrackChart <*> metro "Boston" <*> country "United States") + `shouldHaveJson` + jsonQuery diff --git a/test/api/Json/GroupSpec.hs b/test/api/Json/GroupSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/GroupSpec.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.GroupSpec (spec) where + +import Data.Aeson.Lens +import Network.Lastfm +import Network.Lastfm.Group +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + it "getHype" $ + publicly (getHype <*> groupname) + `shouldHaveJson` + key "weeklyartistchart".key "artist".values.key "mbid"._String + + it "getMembers" $ + publicly (getMembers <*> groupname <* limit 10) + `shouldHaveJson` + key "members".key "user".values.key "name"._String + + it "getWeeklyAlbumChart" $ + publicly (getWeeklyAlbumChart <*> groupname) + `shouldHaveJson` + key "weeklyalbumchart".key "album".values.key "playcount"._String + + it "getWeeklyArtistChart" $ + publicly (getWeeklyArtistChart <*> groupname) + `shouldHaveJson` + key "weeklyartistchart".key "artist".values.key "name"._String + + it "getWeeklyChartList" $ + publicly (getWeeklyChartList <*> groupname) + `shouldHaveJson` + key "weeklychartlist".key "chart".values.key "from"._String + + it "getWeeklyTrackChart" $ + publicly (getWeeklyTrackChart <*> groupname) + `shouldHaveJson` + key "weeklytrackchart".key "track".values.key "url"._String + +groupname :: Request f Group +groupname = group + "People with no social lives that listen to more music than is healthy who are slightly scared of spiders and can never seem to find a pen" diff --git a/test/api/Json/LibrarySpec.hs b/test/api/Json/LibrarySpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/LibrarySpec.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.LibrarySpec (spec) where + +import Data.Aeson.Lens +import Network.Lastfm +import Network.Lastfm.Library +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + it "addAlbum" $ + shouldHaveJson_ . privately $ + addAlbum (pure (albumItem <*> artist "Franz Ferdinand" <*> album "Franz Ferdinand")) + + it "addArtist" $ + shouldHaveJson_ . privately $ + addArtist (pure (artistItem <*> artist "Mobthrow")) + + it "addTrack" $ + shouldHaveJson_ . privately $ + addTrack <*> artist "Eminem" <*> track "Kim" + + it "removeAlbum" $ + shouldHaveJson_ . privately $ + removeAlbum <*> artist "Franz Ferdinand" <*> album "Franz Ferdinand" + + it "removeArtist" $ + shouldHaveJson_ . privately $ + removeArtist <*> artist "Burzum" + + it "removeTrack" $ + shouldHaveJson_ . privately $ + removeTrack <*> artist "Eminem" <*> track "Kim" + + it "removeScrobble" $ + shouldHaveJson_ . privately $ + removeScrobble <*> artist "Gojira" <*> track "Ocean" <*> timestamp 1328905590 + + it "getAlbums" $ + publicly (getAlbums <*> user "smpcln" <* artist "Burzum" <* limit 5) + `shouldHaveJson` + key "albums".key "album".values.key "name"._String + + it "getArtists" $ + publicly (getArtists <*> user "smpcln" <* limit 7) + `shouldHaveJson` + key "artists".key "artist".values.key "name"._String + + it "getTracks" $ + publicly (getTracks <*> user "smpcln" <* artist "Burzum" <* limit 4) + `shouldHaveJson` + key "tracks".key "track".values.key "name"._String diff --git a/test/api/Json/PlaylistSpec.hs b/test/api/Json/PlaylistSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/PlaylistSpec.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.PlaylistSpec (spec) where + +import Control.Lens +import Data.Aeson (Value) +import Data.Aeson.Lens +import Data.Int (Int64) +import Data.Text.Lens (unpacked) +import Network.Lastfm hiding (to) +import Network.Lastfm.Playlist +import Network.Lastfm.User +import Test.Hspec +import Test.HUnit (assertFailure) +import Text.Printf +import Text.Read (readMaybe) + +import SpecHelper + + +spec :: Spec +spec = do + it "create" $ -- Order matters. + privately (create <* title "Awesome playlist") + `shouldHaveJson` + key "playlists".key "playlist".key "title"._String + + it "addTrack" $ do + r <- lastfm $ getPlaylists <*> user "liblastfm" <*> ak' <* json + case r of + Left e -> + assertFailure (printf "last.fm error: %s" (show e)) + Right val -> + case preview pl val of + Just (Just pid) -> shouldHaveJson_ . privately $ + addTrack <*> playlist pid <*> artist "Ruby my dear" <*> track "Chazz" + _ -> assertFailure (printf "bad JSON object: %s" (show val)) + +ak' :: Request f APIKey +ak' = apiKey "29effec263316a1f8a97f753caaa83e0" + +pl :: Fold Value (Maybe Int64) +pl = key "playlists".key "playlist".values.key "id"._String.unpacked.to readMaybe diff --git a/test/api/Json/TagSpec.hs b/test/api/Json/TagSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/TagSpec.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.TagSpec (spec) where + +import Data.Aeson.Lens +import Network.Lastfm +import Network.Lastfm.Tag +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + it "getInfo" $ + publicly (getInfo <*> tag "depressive") + `shouldHaveJson` + key "tag".key "taggings"._String + + it "getSimilar" $ + publicly (getSimilar <*> tag "depressive") + `shouldHaveJson` + key "similartags".key "tag".values.key "name"._String + + it "getTopAlbums" $ + publicly (getTopAlbums <*> tag "depressive" <* limit 2) + `shouldHaveJson` + key "topalbums".key "album".values.key "url"._String + + it "getTopArtists" $ + publicly (getTopArtists <*> tag "depressive" <* limit 3) + `shouldHaveJson` + key "topartists".key "artist".values.key "url"._String + + it "getTopTags" $ + publicly getTopTags + `shouldHaveJson` + key "toptags".key "tag".values.key "name"._String + + it "getTopTracks" $ + publicly (getTopTracks <*> tag "depressive" <* limit 2) + `shouldHaveJson` + key "toptracks".key "track".values.key "url"._String + + it "getWeeklyArtistChart" $ + publicly (getWeeklyArtistChart <*> tag "depressive" <* limit 3) + `shouldHaveJson` + key "weeklyartistchart".key "artist".values.key "name"._String + + it "getWeeklyChartList" $ + publicly (getWeeklyChartList <*> tag "depressive") + `shouldHaveJson` + key "weeklychartlist".key "chart".values.key "from"._String + + it "search" $ + publicly (search <*> tag "depressive" <* limit 3) + `shouldHaveJson` + key "results".key "tagmatches".key "tag".values.key "name"._String diff --git a/test/api/Json/TasteometerSpec.hs b/test/api/Json/TasteometerSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/TasteometerSpec.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.TasteometerSpec (spec) where + +import Data.Aeson (Value) +import Data.Aeson.Lens +import Data.Text (Text) +import Network.Lastfm +import qualified Network.Lastfm.Tasteometer as Taste +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + it "compare" $ + publicly (Taste.compare (user "smpcln") (user "MCDOOMDESTROYER")) + `shouldHaveJson` + jsonQuery + + it "compare" $ + publicly (Taste.compare (user "smpcln") (artists ["enduser", "venetian snares"])) + `shouldHaveJson` + jsonQuery + + it "compare" $ + publicly (Taste.compare (artists ["enduser", "venetian snares"]) (user "smpcln")) + `shouldHaveJson` + jsonQuery + + it "compare" $ + publicly (Taste.compare (artists ["enduser", "venetian snares"]) (artists ["enduser", "venetian snares"])) + `shouldHaveJson` + jsonQuery + +jsonQuery :: Fold Value Text +jsonQuery = key "comparison".key "result".key "score"._String diff --git a/test/api/Json/TrackSpec.hs b/test/api/Json/TrackSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/TrackSpec.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.TrackSpec (spec) where + +import Data.Aeson (Value) +import Data.Aeson.Lens +import Data.Text (Text) +import Network.Lastfm +import Network.Lastfm.Track +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + it "addTags" $ + shouldHaveJson_ . privately $ + addTags <*> artist "Jefferson Airplane" <*> track "White rabbit" <*> tags ["60s", "awesome"] + + it "ban" $ + shouldHaveJson_ . privately $ + ban <*> artist "Eminem" <*> track "Kim" + + it "love" $ + shouldHaveJson_ . privately $ + love <*> artist "Gojira" <*> track "Ocean" + + it "removeTag" $ + shouldHaveJson_ . privately $ + removeTag <*> artist "Jefferson Airplane" <*> track "White rabbit" <*> tag "awesome" + + it "share" $ + shouldHaveJson_ . privately $ + share <*> artist "Led Zeppelin" <*> track "When the Levee Breaks" <*> recipient "liblastfm" <* message "Just listen!" + + it "unban" $ + shouldHaveJson_ . privately $ + unban <*> artist "Eminem" <*> track "Kim" + + it "unlove" $ + shouldHaveJson_ . privately $ + unlove <*> artist "Gojira" <*> track "Ocean" + + it "scrobble" $ + privately (scrobble (pure (item <*> artist "Gojira" <*> track "Ocean" <*> timestamp 1300000000))) + `shouldHaveJson` + key "scrobbles".key "scrobble".key "track".key "#text"._String + + it "updateNowPlaying" $ + privately (updateNowPlaying <*> artist "Gojira" <*> track "Ocean") + `shouldHaveJson` + key "nowplaying".key "track".key "#text"._String + + it "getBuylinks" $ + publicly (getBuyLinks <*> country "United Kingdom" <*> artist "Pink Floyd" <*> track "Brain Damage") + `shouldHaveJson` + key "affiliations".key "downloads".key "affiliation".values.key "supplierName"._String + + it "getCorrection" $ + publicly (getCorrection <*> artist "Pink Ployd" <*> track "Brain Damage") + `shouldHaveJson` + key "corrections".key "correction".key "track".key "artist".key "name"._String + + it "getFingerprintMetadata" $ + publicly (getFingerprintMetadata <*> fingerprint 1234) + `shouldHaveJson` + key "tracks".key "track".values.key "name"._String + + describe "getInfo*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "track".key "userplaycount"._String + + it "getInfo" $ + publicly (getInfo <*> artist "Pink Floyd" <*> track "Comfortably Numb" <* username "aswalrus") + `shouldHaveJson` + jsonQuery + + it "getInfo_mbid" $ + publicly (getInfo <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <* username "aswalrus") + `shouldHaveJson` + jsonQuery + + describe "getShouts*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "shouts".key "shout".values.key "author"._String + + it "getShouts" $ + publicly (getShouts <*> artist "Pink Floyd" <*> track "Comfortably Numb" <* limit 7) + `shouldHaveJson` + jsonQuery + + it "getShouts_mbid" $ + publicly (getShouts <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <* limit 7) + `shouldHaveJson` + jsonQuery + + describe "getSimilar*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "similartracks".key "track".values.key "name"._String + + it "getSimilar" $ + publicly (getSimilar <*> artist "Pink Floyd" <*> track "Comfortably Numb" <* limit 4) + `shouldHaveJson` + jsonQuery + + it "getSimilar_mbid" $ + publicly (getSimilar <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <* limit 4) + `shouldHaveJson` + jsonQuery + + describe "getTags*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "tags".key "@attr".key "track"._String + + it "getTags" $ + publicly (getTags <*> artist "Jefferson Airplane" <*> track "White Rabbit" <* user "liblastfm") + `shouldHaveJson` + jsonQuery + + it "getTags_mbid" $ + publicly (getTags <*> mbid "001b3337-faf4-421a-a11f-45e0b60a7703" <* user "liblastfm") + `shouldHaveJson` + jsonQuery + + describe "getTopFans*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "topfans".key "user".values.key "name"._String + + it "getTopFans" $ + publicly (getTopFans <*> artist "Pink Floyd" <*> track "Comfortably Numb") + `shouldHaveJson` + jsonQuery + + it "getTopFans_mbid" $ + publicly (getTopFans <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92") + `shouldHaveJson` + jsonQuery + + describe "getTopTags*" $ do + let jsonQuery :: Fold Value Text + jsonQuery = key "toptags".key "tag".values.key "name"._String + + it "getTopTags" $ + publicly (getTopTags <*> artist "Pink Floyd" <*> track "Comfortably Numb") + `shouldHaveJson` + jsonQuery + + it "getTopTags_mbid" $ + publicly (getTopTags <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92") + `shouldHaveJson` + jsonQuery + + it "search" $ + publicly (search <*> track "Believe" <* limit 12) + `shouldHaveJson` + key "results".key "trackmatches".key "track".values.key "name"._String diff --git a/test/api/Json/UserSpec.hs b/test/api/Json/UserSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/UserSpec.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.UserSpec (spec) where + +import Data.Aeson.Lens +import Network.Lastfm +import Network.Lastfm.User +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + it "getRecentStations" $ + privately (getRecentStations <*> user "liblastfm" <* limit 10) + `shouldHaveJson` + key "recentstations".key "station".values.key "name"._String + + it "getRecommendedArtists" $ + privately (getRecommendedArtists <* limit 10) + `shouldHaveJson` + key "recommendations".key "artist".values.key "name"._String + + it "getRecommendedEvents" $ + privately (getRecommendedEvents <* limit 10) + `shouldHaveJson` + key "events".key "event".key "url"._String + + it "shout" $ + shouldHaveJson_ . privately $ + shout <*> user "liblastfm" <*> message "test message" + + it "getArtistTracks" $ + publicly (getArtistTracks <*> user "smpcln" <*> artist "Dvar") + `shouldHaveJson` + key "artisttracks".key "track".values.key "name"._String + + it "getBannedTracks" $ + publicly (getBannedTracks <*> user "smpcln" <* limit 10) + `shouldHaveJson` + key "bannedtracks".key "track".values.key "name"._String + + it "getEvents" $ + publicly (getEvents <*> user "chansonnier" <* limit 5) + `shouldHaveJson` + key "events".key "event".values.key "venue".key "url"._String + + it "getFriends" $ + publicly (getFriends <*> user "smpcln" <* limit 10) + `shouldHaveJson` + key "friends".key "user".values.key "name"._String + + it "getPlayCount" $ + publicly (getInfo <*> user "smpcln") + `shouldHaveJson` + key "user".key "playcount"._String + + it "getGetLovedTracks" $ + publicly (getLovedTracks <*> user "smpcln" <* limit 10) + `shouldHaveJson` + key "lovedtracks".key "track".values.key "name"._String + + it "getNeighbours" $ + publicly (getNeighbours <*> user "smpcln" <* limit 10) + `shouldHaveJson` + key "neighbours".key "user".values.key "name"._String + + it "getNewReleases" $ + publicly (getNewReleases <*> user "rj") + `shouldHaveJson` + key "albums".key "album".values.key "url"._String + + it "getPastEvents" $ + publicly (getPastEvents <*> user "mokele" <* limit 5) + `shouldHaveJson` + key "events".key "event".values.key "url"._String + + it "getPersonalTags" $ + publicly (getPersonalTags <*> user "crackedcore" <*> tag "rhythmic noise" <*> taggingType "artist" <* limit 10) + `shouldHaveJson` + key "taggings".key "artists".key "artist".values.key "name"._String + + it "getPlaylists" $ + publicly (getPlaylists <*> user "mokele") + `shouldHaveJson` + key "playlists".key "playlist".values.key "title"._String + + it "getRecentTracks" $ + publicly (getRecentTracks <*> user "smpcln" <* limit 10) + `shouldHaveJson` + key "recenttracks".key "track".values.key "name"._String + + it "getShouts" $ + publicly (getShouts <*> user "smpcln" <* limit 2) + `shouldHaveJson` + key "shouts".key "shout".values.key "body"._String + + it "getTopAlbums" $ + publicly (getTopAlbums <*> user "smpcln" <* limit 5) + `shouldHaveJson` + key "topalbums".key "album".values.key "artist".key "name"._String + + it "getTopArtists" $ + publicly (getTopArtists <*> user "smpcln" <* limit 5) + `shouldHaveJson` + key "topartists".key "artist".values.key "name"._String + + it "getTopTags" $ + publicly (getTopTags <*> user "smpcln" <* limit 10) + `shouldHaveJson` + key "toptags".key "tag".values.key "name"._String + + it "getTopTracks" $ + publicly (getTopTracks <*> user "smpcln" <* limit 10) + `shouldHaveJson` + key "toptracks".key "track".values.key "url"._String + + it "getWeeklyAlbumChart" $ + publicly (getWeeklyAlbumChart <*> user "smpcln") + `shouldHaveJson` + key "weeklyalbumchart".key "album".values.key "url"._String + + it "getWeeklyArtistChart" $ + publicly (getWeeklyArtistChart <*> user "smpcln") + `shouldHaveJson` + key "weeklyartistchart".key "artist".values.key "url"._String + + it "getWeeklyChartList" $ + publicly (getWeeklyChartList <*> user "smpcln") + `shouldHaveJson` + key "weeklychartlist".key "chart".values.key "from"._String + + it "getWeeklyTrackChart" $ + publicly (getWeeklyTrackChart <*> user "smpcln") + `shouldHaveJson` + key "weeklytrackchart".key "track".values.key "url"._String diff --git a/test/api/Json/VenueSpec.hs b/test/api/Json/VenueSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Json/VenueSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Json.VenueSpec (spec) where + +import Data.Aeson.Lens +import Network.Lastfm +import Network.Lastfm.Venue +import Test.Hspec + +import SpecHelper + + +spec :: Spec +spec = do + it "getEvents" $ + publicly (getEvents <*> venue 9163107) + `shouldHaveJson` + key "events".key "event".values.key "venue".key "name"._String + + it "getPastEvents" $ + publicly (getPastEvents <*> venue 9163107 <* limit 2) + `shouldHaveJson` + key "events".key "event".values.key "title"._String + + it "search" $ + publicly (search <*> venueName "Arena") + `shouldHaveJson` + key "results".key "venuematches".key "venue".values.key "id"._String diff --git a/test/api/Spec.hs b/test/api/Spec.hs new file mode 100644 --- /dev/null +++ b/test/api/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/api/SpecHelper.hs b/test/api/SpecHelper.hs new file mode 100644 --- /dev/null +++ b/test/api/SpecHelper.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +module SpecHelper + ( -- * Expectations + Fold + , shouldHaveResponse + , shouldHaveJson + , shouldHaveJson_ + , shouldHaveXml + , shouldHaveXml_ + -- * public data + , publicly + , publicKey + -- * private data + -- $awful + , privately + , privateAPIKey + , privateSessionKey + , privateSecret + ) 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 + +infixl 1 `shouldHaveJson`, `shouldHaveXml` + + +-- | Inspect 'Response' with 'Query' +shouldHaveResponse :: (Show r, Supported f r) => Request f Ready -> Fold r a -> Expectation +shouldHaveResponse q l = do + r <- lastfm q + case preview (_Right.l) r of + Just _ -> return () + Nothing -> assertFailure (printf "Query failed on %s" (show r)) + +shouldHaveJson :: Request JSON Ready -> Fold Value a -> Expectation +shouldHaveJson = shouldHaveResponse + +shouldHaveXml :: Request XML Ready -> Fold Document a -> Expectation +shouldHaveXml = shouldHaveResponse + +-- | Check success stuff for POST requests +shouldHaveJson_ :: Request JSON Ready -> Expectation +shouldHaveJson_ l = shouldHaveResponse l (key "status".only "ok") + +shouldHaveXml_ :: Request XML Ready -> Expectation +shouldHaveXml_ l = shouldHaveResponse l (root.attributed (ix "status".only "ok")) + +-- | Make a request using public API key +publicly :: Request f (APIKey -> Ready) -> Request f Ready +publicly r = r <*> publicKey + +-- | API Key used for requests that do not require authentification +publicKey :: Request f APIKey +publicKey = apiKey "234fc6e0f41f6ef99b7bd62ebaf8d318" + +-- | Environment is missing a variable +data EnvironmentMissing = EnvironmentMissing String deriving (Show, Eq, Typeable) + +instance Exception EnvironmentMissing + +-- $awful + +-- | Make a request signed by a secret using private API and session keys +privately :: Request f (APIKey -> SessionKey -> Sign) -> Request f Ready +privately r = sign privateSecret $ r <*> privateAPIKey <*> privateSessionKey + +privateAPIKey :: Request f APIKey +privateAPIKey = apiKey (liblastfmEnv "HASKELL_LIBLASTFM_APIKEY") + +privateSessionKey :: Request f SessionKey +privateSessionKey = sessionKey (liblastfmEnv "HASKELL_LIBLASTFM_SESSIONKEY") + +privateSecret :: Secret +privateSecret = Secret (liblastfmEnv "HASKELL_LIBLASTFM_SECRET") + +-- | Get an environment variable or throw a 'EnvironmentMissing' exception +liblastfmEnv :: String -> Text +liblastfmEnv var = unsafePerformIO $ do + mv <- lookupEnv var + case mv of + Just v -> return (pack v) + Nothing -> throwIO (EnvironmentMissing var) diff --git a/test/api/Xml/AlbumSpec.hs b/test/api/Xml/AlbumSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/AlbumSpec.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.AlbumSpec (spec) where + +import Data.Text (Text) +import Network.Lastfm +import Network.Lastfm.Album +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "addTags" $ + shouldHaveXml_ . privately $ + addTags <*> artist "Pink Floyd" <*> album "The Wall" <*> tags ["70s", "awesome", "classic"] + + it "getTags-authenticated" $ + privately (getTags <*> artist "Pink Floyd" <*> album "The Wall") + `shouldHaveXml` + root.node "tags".node "tag".node "name".text + + it "removeTag" $ + shouldHaveXml_ . privately $ + removeTag <*> artist "Pink Floyd" <*> album "The Wall" <*> tag "awesome" + + it "share" $ + shouldHaveXml_ . privately $ + share <*> album "Jerusalem" <*> artist "Sleep" <*> recipient "liblastfm" <* message "Just listen!" + + describe "getBuyLinks*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "affiliations".node "physicals".node "affiliation".node "supplierName".text + + it "getBuyLinks" $ + publicly (getBuyLinks <*> country "United Kingdom" <*> artist "Pink Floyd" <*> album "The Wall") + `shouldHaveXml` + xmlQuery + + it "getBuyLinks_mbid" $ + publicly (getBuyLinks <*> country "United Kingdom" <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34") + `shouldHaveXml` + xmlQuery + + describe "getInfo*" $ do + let jsonQuery :: Fold Document Text + jsonQuery = root.node "album".node "toptags".node "tag".node "name".text + + it "getInfo" $ + publicly (getInfo <*> artist "Pink Floyd" <*> album "The Wall") + `shouldHaveXml` + jsonQuery + + it "getInfo_mbid" $ + publicly (getInfo <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34") + `shouldHaveXml` + jsonQuery + + describe "getShouts*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "shouts".node "shout".node "body".text + + it "getShouts" $ + publicly (getShouts <*> artist "Pink Floyd" <*> album "The Wall" <* limit 7) + `shouldHaveXml` + xmlQuery + + it "getShouts_mbid" $ + publicly (getShouts <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34" <* limit 7) + `shouldHaveXml` + xmlQuery + + describe "getTags*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "tags".node "tag".node "name".text + + it "getTags" $ + publicly (getTags <*> artist "Pink Floyd" <*> album "The Wall" <* user "liblastfm") + `shouldHaveXml` + xmlQuery + + it "getTags_mbid" $ + publicly (getTags <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34" <* user "liblastfm") + `shouldHaveXml` + xmlQuery + + describe "getTopTags*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "toptags".node "tag".node "count".text + + it "getTopTags" $ + publicly (getTopTags <*> artist "Pink Floyd" <*> album "The Wall") + `shouldHaveXml` + xmlQuery + + it "getTopTags_mbid" $ + publicly (getTopTags <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34") + `shouldHaveXml` + xmlQuery + + it "search" $ + publicly (search <*> album "wall" <* limit 5) + `shouldHaveXml` + root.node "results".node "albummatches".node "album".node "name".text diff --git a/test/api/Xml/ArtistSpec.hs b/test/api/Xml/ArtistSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/ArtistSpec.hs @@ -0,0 +1,196 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.ArtistSpec (spec) where + +import Data.Text (Text) +import Data.Traversable (traverse) +import Network.Lastfm +import Network.Lastfm.Artist +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do +  it "addTags" $ +   shouldHaveXml_ . privately $ +     addTags <*> artist "Егор Летов" <*> tags ["russian", "black metal"] + +  it "getTags-authenticated" $ + privately (getTags <*> artist "Егор Летов") + `shouldHaveXml` +   root.node "tags".node "tag".node "name".text + +  it "removeTag" $ +   shouldHaveXml_ . privately $ + removeTag <*> artist "Егор Летов" <*> tag "russian" + +  it "share" $ +   shouldHaveXml_ . privately $ + share <*> artist "Sleep" <*> recipient "liblastfm" <* message "Just listen!" + +  it "getCorrection" $ +   publicly (getCorrection <*> artist "Meshugah") + `shouldHaveXml` +   root.node "corrections".node "correction".node "artist".node "name".text + + describe "getEvents*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "events".attr "artist".traverse + +   it "getEvents" $ +     publicly (getEvents <*> artist "Meshuggah" <* limit 2) + `shouldHaveXml` +   xmlQuery + +   it "getEvents_mbid" $ +     publicly (getEvents <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 2) + `shouldHaveXml` +   xmlQuery + + describe "getInfo*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "artist".node "stats".node "listeners".text + +   it "getInfo" $ +     publicly (getInfo <*> artist "Meshuggah") + `shouldHaveXml` +   xmlQuery + +   it "getInfo_mbid" $ +     publicly (getInfo <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413") + `shouldHaveXml` +   xmlQuery + + describe "getPastEvents*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "events".node "event".node "title".text + +   it "getPastEvents" $ + publicly (getPastEvents <*> artist "Meshuggah" <* autocorrect True) + `shouldHaveXml` +   xmlQuery + +   it "getPastEvents_mbid" $ + publicly (getPastEvents <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* autocorrect True) + `shouldHaveXml` +   xmlQuery + + describe "getPodcast*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "rss".node "channel".node "description".text + +   it "getPodcast" $ +     publicly (getPodcast <*> artist "Meshuggah") + `shouldHaveXml` +   xmlQuery + +   it "getPodcast_mbid" $ +     publicly (getPodcast <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413") + `shouldHaveXml` +   xmlQuery + + describe "getShouts*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "shouts".node "shout".node "author".text + +   it "getShouts" $ +     publicly (getShouts <*> artist "Meshuggah" <* limit 5) + `shouldHaveXml` +   xmlQuery + +   it "getShouts_mbid" $ +     publicly (getShouts <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 5) + `shouldHaveXml` +   xmlQuery + + describe "getSimilar*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "similarartists".node "artist".node "name".text + +   it "getSimilar" $ +     publicly (getSimilar <*> artist "Meshuggah" <* limit 3) + `shouldHaveXml` +   xmlQuery + +   it "getSimilar_mbid" $ +     publicly (getSimilar <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 3) + `shouldHaveXml` +   xmlQuery + + describe "getTags*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "tags".node "tag".node "name".text + +   it "getTags" $ +     publicly (getTags <*> artist "Егор Летов" <* user "liblastfm") + `shouldHaveXml` +   xmlQuery + +   it "getTags_mbid" $ +     publicly (getTags <*> mbid "cfb3d32e-d095-4d63-946d-9daf06932180" <* user "liblastfm") + `shouldHaveXml` +   xmlQuery + + describe "getTopAlbums*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "topalbums".node "album".node "name".text + +   it "getTopAlbums" $ +     publicly (getTopAlbums <*> artist "Meshuggah" <* limit 3) + `shouldHaveXml` +   xmlQuery + +   it "getTopAlbums_mbid" $ +     publicly (getTopAlbums <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 3) + `shouldHaveXml` +   xmlQuery + + describe "getTopFans*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "topfans".node "user".node "name".text + +   it "getTopFans" $ +     publicly (getTopFans <*> artist "Meshuggah") + `shouldHaveXml` +   xmlQuery + +   it "getTopFans_mbid" $ +     publicly (getTopFans <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413") + `shouldHaveXml` +   xmlQuery + + describe "getTopTags*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "toptags".node "tag".node "name".text + +   it "getTopTags" $ +     publicly (getTopTags <*> artist "Meshuggah") + `shouldHaveXml` +   xmlQuery + +   it "getTopTags_mbid" $ +     publicly (getTopTags <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413") + `shouldHaveXml` +   xmlQuery + + describe "getTopTracks*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "toptracks".node "track".node "name".text + +   it "getTopTracks" $ +     publicly (getTopTracks <*> artist "Meshuggah" <* limit 3) + `shouldHaveXml` +   xmlQuery + +   it "getTopTracks_mbid" $ +     publicly (getTopTracks <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 3) + `shouldHaveXml` +   xmlQuery + +  it "search" $ + publicly (search <*> artist "Mesh" <* limit 3) + `shouldHaveXml` +   root.node "results".node "artistmatches".node "artist".node "name".text diff --git a/test/api/Xml/ChartSpec.hs b/test/api/Xml/ChartSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/ChartSpec.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.ChartSpec (spec) where + +import Data.Text (Text) +import Network.Lastfm +import Network.Lastfm.Chart +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + describe "get*Artists" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "artists".node "artist".node "name".text + + it "getHypedArtists" $ + publicly (getHypedArtists <* limit 3) + `shouldHaveXml` + xmlQuery + + it "getTopArtists" $ + publicly (getTopArtists <* limit 4) + `shouldHaveXml` + xmlQuery + + describe "get*Tracks" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "tracks".node "track".node "name".text + + it "getHypedTracks" $ + publicly (getHypedTracks <* limit 2) + `shouldHaveXml` + xmlQuery + + it "getLovedTracks" $ + publicly (getLovedTracks <* limit 3) + `shouldHaveXml` + xmlQuery + + it "getTopTracks" $ + publicly (getTopTracks <* limit 2) + `shouldHaveXml` + xmlQuery + + it "getTopTags" $ + publicly (getTopTags <* limit 5) + `shouldHaveXml` + root.node "tags".node "tag".node "name".text diff --git a/test/api/Xml/EventSpec.hs b/test/api/Xml/EventSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/EventSpec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.EventSpec (spec) where + +import Network.Lastfm +import Network.Lastfm.Event +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "attend" $ + shouldHaveXml_ . privately $ + attend <*> event 3142549 <*> status Attending + + it "share" $ + shouldHaveXml_ . privately $ + share <*> event 3142549 <*> recipient "liblastfm" <* message "Just listen!" + + it "getAttendees" $ + publicly (getAttendees <*> event 3142549 <* limit 2) + `shouldHaveXml` + root.node "attendees".node "user".node "name".text + + it "getInfo" $ + publicly (getInfo <*> event 3142549) + `shouldHaveXml` + root.node "event".node "venue".node "location".node "country".text + + it "getShouts" $ + publicly (getShouts <*> event 3142549 <* limit 1) + `shouldHaveXml` + root.node "shouts".node "shout".node "body".text diff --git a/test/api/Xml/GeoSpec.hs b/test/api/Xml/GeoSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/GeoSpec.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.GeoSpec (spec) where + +import Data.Text (Text) +import Network.Lastfm +import Network.Lastfm.Geo +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "getEvents" $ + publicly (getEvents <* location "Moscow" <* limit 5) + `shouldHaveXml` + root.node "events".node "event".node "id".text + + describe "get*Artist*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "topartists".node "artist".node "name".text + + it "getMetroArtistChart" $ + publicly (getMetroArtistChart <*> metro "Saint Petersburg" <*> country "Russia") + `shouldHaveXml` + xmlQuery + + it "getMetroHypeArtistChart" $ + publicly (getMetroHypeArtistChart <*> metro "New York" <*> country "United States") + `shouldHaveXml` + xmlQuery + + it "getMetroUniqueArtistChart" $ + publicly (getMetroUniqueArtistChart <*> metro "Minsk" <*> country "Belarus") + `shouldHaveXml` + xmlQuery + + it "getTopArtists" $ + publicly (getTopArtists <*> country "Belarus" <* limit 3) + `shouldHaveXml` + xmlQuery + + it "getMetroWeeklyChartlist" $ + publicly (getMetroWeeklyChartlist <*> metro "Moscow") + `shouldHaveXml` + root.node "weeklychartlist".node "chart".attr "from" + + it "getMetros" $ + publicly (getMetros <* country "Russia") + `shouldHaveXml` + root.node "metros".node "metro".node "name".text + + describe "get*Track*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "toptracks".node "track".node "name".text + + it "getTopTracks" $ + publicly (getTopTracks <*> country "Ukraine" <* limit 2) + `shouldHaveXml` + xmlQuery + + it "getMetroUniqueTrackChart" $ + publicly (getMetroUniqueTrackChart <*> metro "Moscow" <*> country "Russia") + `shouldHaveXml` + xmlQuery + + it "getMetroHypeTrackChart" $ + publicly (getMetroHypeTrackChart <*> metro "Moscow" <*> country "Russia") + `shouldHaveXml` + xmlQuery + + it "getMetroTrackChart" $ + publicly (getMetroTrackChart <*> metro "Boston" <*> country "United States") + `shouldHaveXml` + xmlQuery diff --git a/test/api/Xml/GroupSpec.hs b/test/api/Xml/GroupSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/GroupSpec.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.GroupSpec (spec) where + +import Network.Lastfm +import Network.Lastfm.Group +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "getHype" $ + publicly (getHype <*> groupname) + `shouldHaveXml` + root.node "weeklyartistchart".node "artist".node "mbid".text + + it "getMembers" $ + publicly (getMembers <*> groupname <* limit 10) + `shouldHaveXml` + root.node "members".node "user".node "name".text + + it "getWeeklyAlbumChart" $ + publicly (getWeeklyAlbumChart <*> groupname) + `shouldHaveXml` + root.node "weeklyalbumchart".node "album".node "playcount".text + + it "getWeeklyArtistChart" $ + publicly (getWeeklyArtistChart <*> groupname) + `shouldHaveXml` + root.node "weeklyartistchart".node "artist".node "name".text + + it "getWeeklyChartList" $ + publicly (getWeeklyChartList <*> groupname) + `shouldHaveXml` + root.node "weeklychartlist".node "chart".attr "from" + + it "getWeeklyTrackChart" $ + publicly (getWeeklyTrackChart <*> groupname) + `shouldHaveXml` + root.node "weeklytrackchart".node "track".node "url".text + +groupname :: Request f Group +groupname = group + "People with no social lives that listen to more music than is healthy who are slightly scared of spiders and can never seem to find a pen" diff --git a/test/api/Xml/LibrarySpec.hs b/test/api/Xml/LibrarySpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/LibrarySpec.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.LibrarySpec (spec) where + +import Network.Lastfm +import Network.Lastfm.Library +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "addAlbum" $ + shouldHaveXml_ . privately $ + addAlbum (pure (albumItem <*> artist "Franz Ferdinand" <*> album "Franz Ferdinand")) + + it "addArtist" $ + shouldHaveXml_ . privately $ + addArtist (pure (artistItem <*> artist "Mobthrow")) + + it "addTrack" $ + shouldHaveXml_ . privately $ + addTrack <*> artist "Eminem" <*> track "Kim" + + it "removeAlbum" $ + shouldHaveXml_ . privately $ + removeAlbum <*> artist "Franz Ferdinand" <*> album "Franz Ferdinand" + + it "removeArtist" $ + shouldHaveXml_ . privately $ + removeArtist <*> artist "Burzum" + + it "removeTrack" $ + shouldHaveXml_ . privately $ + removeTrack <*> artist "Eminem" <*> track "Kim" + + it "removeScrobble" $ + shouldHaveXml_ . privately $ + removeScrobble <*> artist "Gojira" <*> track "Ocean" <*> timestamp 1328905590 + + it "getAlbums" $ + publicly (getAlbums <*> user "smpcln" <* artist "Burzum" <* limit 5) + `shouldHaveXml` + root.node "albums".node "album".node "name".text + + it "getArtists" $ + publicly (getArtists <*> user "smpcln" <* limit 7) + `shouldHaveXml` + root.node "artists".node "artist".node "name".text + + it "getTracks" $ + publicly (getTracks <*> user "smpcln" <* artist "Burzum" <* limit 4) + `shouldHaveXml` + root.node "tracks".node "track".node "name".text diff --git a/test/api/Xml/PlaylistSpec.hs b/test/api/Xml/PlaylistSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/PlaylistSpec.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.PlaylistSpec (spec) where + +import Control.Lens +import Data.Int (Int64) +import Data.Text.Lens (unpacked) +import Network.Lastfm hiding (to) +import Network.Lastfm.Playlist +import Network.Lastfm.User +import Test.Hspec +import Test.HUnit (assertFailure) +import Text.Printf +import Text.Read (readMaybe) +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "create" $ -- Order matters. + privately (create <* title "Awesome playlist") + `shouldHaveXml` + root.node "playlists".node "playlist".node "title".text + + it "addTrack" $ do + r <- lastfm $ getPlaylists <*> user "liblastfm" <*> ak' <* Network.Lastfm.xml + case r of + Left e -> + assertFailure (printf "last.fm error: %s" (show e)) + Right val -> + case preview pl val of + Just (Just pid) -> shouldHaveXml_ . privately $ + addTrack <*> playlist pid <*> artist "Ruby my dear" <*> track "Chazz" + _ -> assertFailure (printf "bad XML object: %s" (show val)) + +ak' :: Request f APIKey +ak' = apiKey "29effec263316a1f8a97f753caaa83e0" + +pl :: Fold Document (Maybe Int64) +pl = root.node "playlists".node "playlist".node "id".text.unpacked.to readMaybe diff --git a/test/api/Xml/TagSpec.hs b/test/api/Xml/TagSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/TagSpec.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.TagSpec (spec) where + +import Network.Lastfm +import Network.Lastfm.Tag +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "getInfo" $ + publicly (getInfo <*> tag "depressive") + `shouldHaveXml` + root.node "tag".node "taggings".text + + it "getSimilar" $ + publicly (getSimilar <*> tag "depressive") + `shouldHaveXml` + root.node "similartags".node "tag".node "name".text + + it "getTopAlbums" $ + publicly (getTopAlbums <*> tag "depressive" <* limit 2) + `shouldHaveXml` + root.node "topalbums".node "album".node "url".text + + it "getTopArtists" $ + publicly (getTopArtists <*> tag "depressive" <* limit 3) + `shouldHaveXml` + root.node "topartists".node "artist".node "url".text + + it "getTopTags" $ + publicly getTopTags + `shouldHaveXml` + root.node "toptags".node "tag".node "name".text + + it "getTopTracks" $ + publicly (getTopTracks <*> tag "depressive" <* limit 2) + `shouldHaveXml` + root.node "toptracks".node "track".node "url".text + + it "getWeeklyArtistChart" $ + publicly (getWeeklyArtistChart <*> tag "depressive" <* limit 3) + `shouldHaveXml` + root.node "weeklyartistchart".node "artist".node "name".text + + it "getWeeklyChartList" $ + publicly (getWeeklyChartList <*> tag "depressive") + `shouldHaveXml` + root.node "weeklychartlist".node "chart".attr "from" + + it "search" $ + publicly (search <*> tag "depressive" <* limit 3) + `shouldHaveXml` + root.node "results".node "tagmatches".node "tag".node "name".text diff --git a/test/api/Xml/TasteometerSpec.hs b/test/api/Xml/TasteometerSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/TasteometerSpec.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.TasteometerSpec (spec) where + +import Data.Text (Text) +import Network.Lastfm +import qualified Network.Lastfm.Tasteometer as Taste +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "compare" $ + publicly (Taste.compare (user "smpcln") (user "MCDOOMDESTROYER")) + `shouldHaveXml` + xmlQuery + + it "compare" $ + publicly (Taste.compare (user "smpcln") (artists ["enduser", "venetian snares"])) + `shouldHaveXml` + xmlQuery + + it "compare" $ + publicly (Taste.compare (artists ["enduser", "venetian snares"]) (user "smpcln")) + `shouldHaveXml` + xmlQuery + + it "compare" $ + publicly (Taste.compare (artists ["enduser", "venetian snares"]) (artists ["enduser", "venetian snares"])) + `shouldHaveXml` + xmlQuery + +xmlQuery :: Fold Document Text +xmlQuery = root.node "comparison".node "result".node "score".text diff --git a/test/api/Xml/TrackSpec.hs b/test/api/Xml/TrackSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/TrackSpec.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.TrackSpec (spec) where + +import Data.Text (Text) +import Data.Traversable (traverse) +import Network.Lastfm +import Network.Lastfm.Track +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "addTags" $ + shouldHaveXml_ . privately $ + addTags <*> artist "Jefferson Airplane" <*> track "White rabbit" <*> tags ["60s", "awesome"] + + it "ban" $ + shouldHaveXml_ . privately $ + ban <*> artist "Eminem" <*> track "Kim" + + it "love" $ + shouldHaveXml_ . privately $ + love <*> artist "Gojira" <*> track "Ocean" + + it "removeTag" $ + shouldHaveXml_ . privately $ + removeTag <*> artist "Jefferson Airplane" <*> track "White rabbit" <*> tag "awesome" + + it "share" $ + shouldHaveXml_ . privately $ + share <*> artist "Led Zeppelin" <*> track "When the Levee Breaks" <*> recipient "liblastfm" <* message "Just listen!" + + it "unban" $ + shouldHaveXml_ . privately $ + unban <*> artist "Eminem" <*> track "Kim" + + it "unlove" $ + shouldHaveXml_ . privately $ + unlove <*> artist "Gojira" <*> track "Ocean" + + it "scrobble" $ + privately (scrobble (pure (item <*> artist "Gojira" <*> track "Ocean" <*> timestamp 1300000000))) + `shouldHaveXml` + root.node "scrobbles".node "scrobble".node "track".text + + it "updateNowPlaying" $ + privately (updateNowPlaying <*> artist "Gojira" <*> track "Ocean") + `shouldHaveXml` + root.node "nowplaying".node "track".text + + it "getBuylinks" $ + publicly (getBuyLinks <*> country "United Kingdom" <*> artist "Pink Floyd" <*> track "Brain Damage") + `shouldHaveXml` + root.node "affiliations".node "downloads".node "affiliation".node "supplierName".text + + it "getCorrection" $ + publicly (getCorrection <*> artist "Pink Ployd" <*> track "Brain Damage") + `shouldHaveXml` + root.node "corrections".node "correction".node "track".node "artist".node "name".text + + it "getFingerprintMetadata" $ + publicly (getFingerprintMetadata <*> fingerprint 1234) + `shouldHaveXml` + root.node "tracks".node "track".node "name".text + + describe "getInfo*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "track".node "userplaycount".text + + it "getInfo" $ + publicly (getInfo <*> artist "Pink Floyd" <*> track "Comfortably Numb" <* username "aswalrus") + `shouldHaveXml` + xmlQuery + + it "getInfo_mbid" $ + publicly (getInfo <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <* username "aswalrus") + `shouldHaveXml` + xmlQuery + + describe "getShouts*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "shouts".node "shout".node "author".text + + it "getShouts" $ + publicly (getShouts <*> artist "Pink Floyd" <*> track "Comfortably Numb" <* limit 7) + `shouldHaveXml` + xmlQuery + + it "getShouts_mbid" $ + publicly (getShouts <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <* limit 7) + `shouldHaveXml` + xmlQuery + + describe "getSimilar*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "similartracks".node "track".node "name".text + + it "getSimilar" $ + publicly (getSimilar <*> artist "Pink Floyd" <*> track "Comfortably Numb" <* limit 4) + `shouldHaveXml` + xmlQuery + + it "getSimilar_mbid" $ + publicly (getSimilar <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <* limit 4) + `shouldHaveXml` + xmlQuery + + describe "getTags*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "tags".attr "track".traverse + + it "getTags" $ + publicly (getTags <*> artist "Jefferson Airplane" <*> track "White Rabbit" <* user "liblastfm") + `shouldHaveXml` + xmlQuery + + it "getTags_mbid" $ + publicly (getTags <*> mbid "001b3337-faf4-421a-a11f-45e0b60a7703" <* user "liblastfm") + `shouldHaveXml` + xmlQuery + + describe "getTopFans*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "topfans".node "user".node "name".text + + it "getTopFans" $ + publicly (getTopFans <*> artist "Pink Floyd" <*> track "Comfortably Numb") + `shouldHaveXml` + xmlQuery + + it "getTopFans_mbid" $ + publicly (getTopFans <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92") + `shouldHaveXml` + xmlQuery + + describe "getTopTags*" $ do + let xmlQuery :: Fold Document Text + xmlQuery = root.node "toptags".node "tag".node "name".text + + it "getTopTags" $ + publicly (getTopTags <*> artist "Pink Floyd" <*> track "Comfortably Numb") + `shouldHaveXml` + xmlQuery + + it "getTopTags_mbid" $ + publicly (getTopTags <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92") + `shouldHaveXml` + xmlQuery + + it "search" $ + publicly (search <*> track "Believe" <* limit 12) + `shouldHaveXml` + root.node "results".node "trackmatches".node "track".node "name".text diff --git a/test/api/Xml/UserSpec.hs b/test/api/Xml/UserSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/UserSpec.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.UserSpec (spec) where + +import Network.Lastfm +import Network.Lastfm.User +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "getRecentStations" $ + privately (getRecentStations <*> user "liblastfm" <* limit 10) + `shouldHaveXml` + root.node "recentstations".node "station".node "name".text + + it "getRecommendedArtists" $ + privately (getRecommendedArtists <* limit 10) + `shouldHaveXml` + root.node "recommendations".node "artist".node "name".text + + it "getRecommendedEvents" $ + privately (getRecommendedEvents <* limit 10) + `shouldHaveXml` + root.node "events".node "event".node "url".text + + it "shout" $ + shouldHaveXml_ . privately $ + shout <*> user "liblastfm" <*> message "test message" + + it "getArtistTracks" $ + publicly (getArtistTracks <*> user "smpcln" <*> artist "Dvar") + `shouldHaveXml` + root.node "artisttracks".node "track".node "name".text + + it "getBannedTracks" $ + publicly (getBannedTracks <*> user "smpcln" <* limit 10) + `shouldHaveXml` + root.node "bannedtracks".node "track".node "name".text + + it "getEvents" $ + publicly (getEvents <*> user "chansonnier" <* limit 5) + `shouldHaveXml` + root.node "events".node "event".node "venue".node "url".text + + it "getFriends" $ + publicly (getFriends <*> user "smpcln" <* limit 10) + `shouldHaveXml` + root.node "friends".node "user".node "name".text + + it "getPlayCount" $ + publicly (getInfo <*> user "smpcln") + `shouldHaveXml` + root.node "user".node "playcount".text + + it "getGetLovedTracks" $ + publicly (getLovedTracks <*> user "smpcln" <* limit 10) + `shouldHaveXml` + root.node "lovedtracks".node "track".node "name".text + + it "getNeighbours" $ + publicly (getNeighbours <*> user "smpcln" <* limit 10) + `shouldHaveXml` + root.node "neighbours".node "user".node "name".text + + it "getNewReleases" $ + publicly (getNewReleases <*> user "rj") + `shouldHaveXml` + root.node "albums".node "album".node "url".text + + it "getPastEvents" $ + publicly (getPastEvents <*> user "mokele" <* limit 5) + `shouldHaveXml` + root.node "events".node "event".node "url".text + + it "getPersonalTags" $ + publicly (getPersonalTags <*> user "crackedcore" <*> tag "rhythmic noise" <*> taggingType "artist" <* limit 10) + `shouldHaveXml` + root.node "taggings".node "artists".node "artist".node "name".text + + it "getPlaylists" $ + publicly (getPlaylists <*> user "mokele") + `shouldHaveXml` + root.node "playlists".node "playlist".node "title".text + + it "getRecentTracks" $ + publicly (getRecentTracks <*> user "smpcln" <* limit 10) + `shouldHaveXml` + root.node "recenttracks".node "track".node "name".text + + it "getShouts" $ + publicly (getShouts <*> user "smpcln" <* limit 2) + `shouldHaveXml` + root.node "shouts".node "shout".node "body".text + + it "getTopAlbums" $ + publicly (getTopAlbums <*> user "smpcln" <* limit 5) + `shouldHaveXml` + root.node "topalbums".node "album".node "artist".node "name".text + + it "getTopArtists" $ + publicly (getTopArtists <*> user "smpcln" <* limit 5) + `shouldHaveXml` + root.node "topartists".node "artist".node "name".text + + it "getTopTags" $ + publicly (getTopTags <*> user "smpcln" <* limit 10) + `shouldHaveXml` + root.node "toptags".node "tag".node "name".text + + it "getTopTracks" $ + publicly (getTopTracks <*> user "smpcln" <* limit 10) + `shouldHaveXml` + root.node "toptracks".node "track".node "url".text + + it "getWeeklyAlbumChart" $ + publicly (getWeeklyAlbumChart <*> user "smpcln") + `shouldHaveXml` + root.node "weeklyalbumchart".node "album".node "url".text + + it "getWeeklyArtistChart" $ + publicly (getWeeklyArtistChart <*> user "smpcln") + `shouldHaveXml` + root.node "weeklyartistchart".node "artist".node "url".text + + it "getWeeklyChartList" $ + publicly (getWeeklyChartList <*> user "smpcln") + `shouldHaveXml` + root.node "weeklychartlist".node "chart".attr "from" + + it "getWeeklyTrackChart" $ + publicly (getWeeklyTrackChart <*> user "smpcln") + `shouldHaveXml` + root.node "weeklytrackchart".node "track".node "url".text diff --git a/test/api/Xml/VenueSpec.hs b/test/api/Xml/VenueSpec.hs new file mode 100644 --- /dev/null +++ b/test/api/Xml/VenueSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Xml.VenueSpec (spec) where + +import Network.Lastfm +import Network.Lastfm.Venue +import Test.Hspec +import Text.Xml.Lens + +import SpecHelper + + +spec :: Spec +spec = do + it "getEvents" $ + publicly (getEvents <*> venue 9163107) + `shouldHaveXml` + root.node "events".node "event".node "venue".node "name".text + + it "getPastEvents" $ + publicly (getPastEvents <*> venue 9163107 <* limit 2) + `shouldHaveXml` + root.node "events".node "event".node "title".text + + it "search" $ + publicly (search <*> venueName "Arena") + `shouldHaveXml` + root.node "results".node "venuematches".node "venue".node "id".text diff --git a/test/spec/Network/Lastfm/ResponseSpec.hs b/test/spec/Network/Lastfm/ResponseSpec.hs new file mode 100644 --- /dev/null +++ b/test/spec/Network/Lastfm/ResponseSpec.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Network.Lastfm.ResponseSpec (spec) where + +import Control.Exception (ArithException(..), throwIO, try) +import Control.Exception.Lens +import Control.Lens +import Data.Aeson (Value) +import Data.ByteString.Lazy (ByteString) +import Data.Aeson.Lens +import Test.Hspec.Lens +import Text.Xml.Lens +import Network.HTTP.Client (HttpException(..)) + +import Network.Lastfm.Response + + +instance Eq HttpException where + _ == _ = True + + +spec :: Spec +spec = do + describe "md5" $ do + it "calculates the right hash for an empty string" $ + md5 "" `shouldBe` "d41d8cd98f00b204e9800998ecf8427e" + + it "calculates the right hash for an ascii string" $ + md5 "Enduser" `shouldBe` "28ced1fafec20ae302a04e9f27f4800f" + + it "calculates the right hash for a unicode string" $ + md5 "ДМИТРИЙ МАЛИКОВ" `shouldBe` "e02e5affef1004a02d9762619dc2a585" + + describe "try for LastfmError" $ do + let tryLastfmError :: IO a -> IO (Either LastfmError a) + tryLastfmError = try + + it "catches 'HttpException'" $ do + val <- tryLastfmError (throwIO ResponseTimeout) :: IO (Either LastfmError ()) + val `shouldHave` _Left._LastfmHttpError.only ResponseTimeout + + it "does not catch other exceptions" $ + tryLastfmError (throwIO DivideByZero) `shouldThrow` _DivideByZero + + describe "parse" $ do + context "JSON" $ do + let parseJSON :: ByteString -> Either LastfmError Value + parseJSON = parse + + it "handles good input" $ + let + good = "{ \"a\": { \"b\": 4 } }" + in + parseJSON good `shouldHave` _Right.key "a".key "b"._Integer.only 4 + + it "handles malformed input" $ + let + malformed = "not a json" + in + parseJSON malformed `shouldHave` _Left._LastfmBadResponse.only malformed + + it "handles input with encoded errors" $ + let + encodedError = "{ \"error\": 5, \"message\": \"foo\" }" + in + parseJSON encodedError `shouldHave` _Left._LastfmEncodedError.only (5, "foo") + + context "XML" $ do + let parseXML :: ByteString -> Either LastfmError Document + parseXML = parse + + it "handles good input" $ + let + good = "baz" + in + parseXML good `shouldHave` _Right.root.node "foo".node "bar".text.only "baz" + + it "handles malformed input" $ + let + malformed = "not a xml" + in + parseXML malformed `shouldHave` _Left._LastfmBadResponse.only malformed + + it "handles input with encoded errors" $ + let + encodedError = "foo" + in + parseXML encodedError `shouldHave` _Left._LastfmEncodedError.only (5, "foo") diff --git a/test/spec/Spec.hs b/test/spec/Spec.hs new file mode 100644 --- /dev/null +++ b/test/spec/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}