diff --git a/rdioh.cabal b/rdioh.cabal --- a/rdioh.cabal +++ b/rdioh.cabal @@ -1,5 +1,5 @@ name: rdioh -version: 0.1.1 +version: 0.1.2 category: Network, API, Web license: MIT license-file: LICENSE @@ -7,25 +7,28 @@ maintainer: Aditya Bhargava stability: experimental build-type: Simple -cabal-version: >= 1.6 +cabal-version: >= 1.8 synopsis: A Haskell wrapper for Rdio's API. description: This library implements methods for Rdio's API. - It supports 2-legged and 3-legged OAuth. + It supports 2-legged and 3-legged OAuth. See Rdio's API for reference: http://developer.rdio.com/docs/read/rest/Methods library - build-depends: base >= 3 && <= 5 - , mtl - , MissingH - , bytestring - , json - , hoauth - , urlencoded - exposed-modules: Rdioh, RdioResult + build-depends: base >= 3 && <= 5 , mtl , MissingH , bytestring , json , hoauth , urlencoded, aeson, containers, transformers + exposed-modules: Rdioh, Rdioh.Models, Rdioh.Auth hs-source-dirs: src - ghc-options: -W -Wall extensions: FlexibleContexts + +executable rdioh + build-depends: base >= 3 && <= 5 , mtl , MissingH , bytestring , json , hoauth , urlencoded, aeson, containers, transformers + hs-source-dirs: src + main-is: Main.hs + source-repository head type: git location: git@github.com:egonSchiele/rdioh.git +executable rdioh-spec + build-depends: base ==4.5.*, hspec, rdioh, mtl , MissingH , bytestring , json , hoauth , urlencoded, aeson, containers, transformers + hs-source-dirs: spec, src + main-is: Main.hs diff --git a/spec/Main.hs b/spec/Main.hs new file mode 100644 --- /dev/null +++ b/spec/Main.hs @@ -0,0 +1,78 @@ +import Test.Hspec +import Rdioh +import Rdioh.Models +import System.IO.Unsafe +import Data.String.Utils +import Data.Aeson +import qualified Debug.Trace as D + +key = strip . unsafePerformIO . readFile $ "key" +secret = strip . unsafePerformIO . readFile $ "secret" + +testMethod :: (Show a, FromJSON a) => Rdio (Either String a) -> Bool +testMethod meth = unsafePerformIO $ do + result <- runRdio key secret meth + case result of + Left err -> fail err + Right x -> return True + +radiohead = "r91318" +me = "s361565" +emi = "l202397" + +okcomputer = "a171828" +okcomputerShortCode = "QVrGAiJdzXU" +okComputerUrl = "/artist/Radiohead/album/OK_Computer_(Collector%27s_Edition)/" + +main = hspec $ do + describe "make sure methods return valid models" $ do + it "get" $ do + testMethod $ (get [radiohead] [] :: Rdio (Either String Object)) + it "getObjectFromShortCode" $ do + testMethod $ (getObjectFromShortCode okcomputerShortCode [] :: Rdio (Either String Album)) + it "getObjectFromUrl" $ do + testMethod $ (getObjectFromUrl okComputerUrl [] :: Rdio (Either String Album)) + it "getAlbumsByUPC" $ do + testMethod $ getAlbumsByUPC 654979031628 [] + it "getAlbumsForArtist" $ do + testMethod $ getAlbumsForArtist radiohead + it "getAlbumsForLabel" $ do + testMethod $ getAlbumsForLabel emi + it "getArtistsForLabel" $ do + testMethod $ getArtistsForLabel emi + it "getTracksByISRC" $ do + testMethod $ getTracksByISRC "" [] + it "getTracksForArtist" $ do + testMethod $ getTracksForArtist radiohead + it "search" $ do + testMethod $ (search "Radiohead" "Artist" :: Rdio (Either String [Artist])) + it "getAlbumsForArtistInCollection'" $ do + testMethod $ getAlbumsForArtistInCollection' radiohead (Just me) [] Nothing -- me + it "getAlbumsInCollection'" $ do + testMethod $ getAlbumsInCollection' (Just me) Nothing Nothing Nothing Nothing [] + it "getArtistsInCollection'" $ do + testMethod $ getArtistsInCollection' (Just me) Nothing Nothing Nothing Nothing [] + it "getTracksForAlbumInCollection'" $ do + testMethod $ getTracksForAlbumInCollection' okcomputer (Just me) [] + it "getTracksForArtistInCollection'" $ do + testMethod $ getTracksForArtistInCollection' radiohead (Just me) [] + it "getTracksInCollection'" $ do + testMethod $ getTracksInCollection' (Just me) Nothing Nothing Nothing Nothing [] + it "getPlaylists'" $ do + testMethod $ getPlaylists' (Just me) [] Nothing + it "getUserPlaylists" $ do + testMethod $ getUserPlaylists me + it "findUserByEmail" $ do + testMethod $ findUserByEmail "bluemangroupie@gmail.com" [] + it "findUserByName" $ do + testMethod $ findUserByName "egonschiele" [] + it "getNewReleases" $ do + testMethod $ getNewReleases + it "getTopChartArtists" $ do + testMethod $ getTopChartArtists + it "getTopChartAlbums" $ do + testMethod $ getTopChartAlbums + it "getTopChartTracks" $ do + testMethod $ getTopChartTracks + it "getTopChartPlaylists" $ do + testMethod $ getTopChartPlaylists diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,19 @@ +import Rdioh +import System.IO.Unsafe +import Rdioh.Models +import Data.String.Utils +import Control.Monad.IO.Class + +key = strip . unsafePerformIO . readFile $ "key" +secret = strip . unsafePerformIO . readFile $ "secret" + +main = do + runRdio key secret $ do + res1 <- search "Radiohead" "Artist" :: Rdio (Either String [Artist]) + case res1 of + Left err -> liftIO $ putStrLn err + Right (radiohead:_) -> do + res2 <- getAlbumsForArtist (artistKey radiohead) + case res2 of + Left err -> liftIO $ putStrLn err + Right albums -> liftIO $ mapM_ (putStrLn . albumName) albums diff --git a/src/RdioResult.hs b/src/RdioResult.hs deleted file mode 100644 --- a/src/RdioResult.hs +++ /dev/null @@ -1,46 +0,0 @@ -module RdioResult where -import qualified Text.JSON as J -import qualified Data.List as L - --- functions to convert a JSValue to a RdioResult: - --- this one converts all JSONObjects to nice tuples that can be used to make an RDioDict -conv x = RdioDict $ map (\(str, jsval) -> (str, clean jsval) ) $ J.fromJSObject x - --- helper methods to make all values into RdioResult values --- so they can be stuffed into an RDioDict -clean (J.JSObject x) = conv x -clean (J.JSString x) = RdioString $ J.fromJSString x -clean (J.JSBool x) = RdioBool x -clean (J.JSRational _ x) = RdioRational x -clean (J.JSArray xs) = RdioArray $ map clean xs -clean J.JSNull = RdioNull - -data RdioResult = RdioDict {rdioDictValue :: [(String, RdioResult)]} | RdioArray {rdioArrayValue :: [RdioResult]} | RdioString {rdioStringValue :: String} | RdioRational {rdioRationalValue :: Rational} | RdioBool {rdioBoolValue :: Bool} | RdioNull - -dropLast x l = take (L.genericLength l - x) l - -instance Show RdioResult where - show (RdioDict xs) = "{" ++ (dropLast 2 (foldl (\acc (str, obj) -> acc ++ "\"" ++ str ++ "\"" ++ " : " ++ (show obj) ++ ", ") "" xs)) ++ "}" - show (RdioArray xs) = "[" ++ (dropLast 2 (foldl (\acc x -> acc ++ (show x) ++ ", ") "" xs)) ++ "]" - show (RdioString x) = "\"" ++ x ++ "\"" - show (RdioBool x) = show x - show (RdioRational x) = show x - show RdioNull = "" - - -instance J.JSON RdioResult where - showJSON (RdioDict xs) = J.showJSONs xs - showJSON (RdioString x) = J.showJSON x - showJSON (RdioRational x) = J.showJSON (show x) - showJSON (RdioBool x) = J.showJSON (show x) - showJSON (RdioArray xs) = J.showJSONs xs - showJSON RdioNull = J.showJSON "" - readJSON (J.JSObject obj) = J.Ok $ conv obj - --- helper methods for accessing parts of our RdioResult object -(RdioDict xs) ! str = snd . head $ filter (\(key, obj) -> key == str) xs -(RdioArray xs) .! num = xs !! num - -keys (RdioDict xs) = map fst xs -values (RdioDict xs) = map snd xs diff --git a/src/Rdioh.hs b/src/Rdioh.hs --- a/src/Rdioh.hs +++ b/src/Rdioh.hs @@ -1,224 +1,453 @@ {-# LANGUAGE FlexibleContexts #-} -module Rdioh ( -twoLegToken, threeLegToken, -(!), (.!), keys, values, -RdioScope(..), RdioSort(..), RdioObjectType(..), RdioTime(..), RdioResultType(..), RdioType(..), RdioCollaborationMode(..), RdioResult(..), -get, getObjectFromShortCode, getObjectFromUrl, -getAlbumsByUPC, getAlbumsForArtist, getTracksByISRC, getTracksForArtist, search, searchSuggestions, -addToCollection, getAlbumsForArtistInCollection, getAlbumsInCollection, getArtistsInCollection, getTracksForAlbumInCollection, getTracksForArtistInCollection, getTracksInCollection, removeFromCollection, setAvailableOffline, -addToPlaylist, createPlaylist, deletePlaylist, getPlaylists, removeFromPlaylist, setPlaylistCollaborating, setPlaylistCollaborationMode, setPlaylistFields, setPlaylistOrder, -addFriend, currentUser, findUserByEmail, findUserByVanityName, removeFriend, userFollowers, userFollowing, -getActivityStream, getHeavyRotation, getNewReleases, getTopCharts, -getPlaybackToken -) where +module Rdioh where +import Rdioh.Auth +import Data.Either +import qualified Data.ByteString.Lazy.Char8 as B +import qualified Data.List.Utils as U +import Control.Monad.Reader -import Data.Maybe import Network.OAuth.Consumer import Network.OAuth.Http.Request import Network.OAuth.Http.Response import Network.OAuth.Http.HttpClient import Network.OAuth.Http.CurlHttpClient -import Network.OAuth.Http.PercentEncoding -import qualified Data.ByteString.Lazy.Char8 as B -import qualified Data.URLEncoded as UE -import qualified Data.List.Utils as U -import Control.Monad.Reader -import qualified Text.JSON as J -import RdioResult +-- import Network.OAuth.Http.PercentEncoding +import Rdioh.Util +import Rdioh.Models +import Control.Applicative +import Data.Aeson +import qualified Debug.Trace as D +-- | Takes: a key, a secret, a function to run. +runRdio :: String -> String -> Rdio a -> IO a +runRdio key secret func = runReaderT func (twoLegToken key secret) -reqUrl = fromJust . parseURL $ "http://api.rdio.com/oauth/request_token" -accUrl = fromJust . parseURL $ "http://api.rdio.com/oauth/access_token" -authUrl = ("https://www.rdio.com/oauth/authorize?oauth_token="++) . findWithDefault ("oauth_token","ERROR") . oauthParams -srvUrl payload = (fromJust . parseURL $ "http://api.rdio.com/1/") { method = POST - , reqPayload = payload - , reqHeaders = fromList [("content-type", "application/x-www-form-urlencoded")] - } +-- | Same as @runRdio@, but with 3-legged authentication i.e. the user will +-- | have to authorize your app. +runRdioWithAuth :: String -> String -> Rdio a -> IO a +runRdioWithAuth key secret func = do + tok <- liftIO (threeLegToken key secret) + runReaderT func tok -app key secret = Application key secret OOB +-- | The @Rdio@ monad...just a wrapper around a @ReaderT@ monad. +type Rdio a = ReaderT Token IO a --- returns a two-legged auth token -twoLegToken key secret = fromApplication (app key secret) +-- | used internally +mkExtras :: Show e => [e] -> (String, String) +mkExtras extras = ("extras", U.join "," $ show <$> extras) --- given a key and a secret, does three-legged auth and returns an auth token -threeLegToken key secret = runOAuthM (twoLegToken key secret) $ do - signRq2 HMACSHA1 Nothing reqUrl >>= oauthRequest CurlClient - cliAskAuthorization authUrl - signRq2 HMACSHA1 Nothing accUrl >>= oauthRequest CurlClient +-- | Send a arbitrary request to rdio's api. Return type should +-- | be an instance of @FromJSON@, and you need to specify the type. Example: +-- +-- > result <- (runRequest [("method", "getTopCharts"), ("type", "Artist")] :: Rdio (Either String [Artist])) +runRequest :: (Show v, FromJSON v) => [(String, String)] -> Rdio (Either String v) +runRequest params = do + tok <- ask + let request = srvUrl . B.pack . toParams $ params + response <- liftIO $ runOAuthM tok $ do + request_ <- signRq2 HMACSHA1 Nothing request + serviceRequest CurlClient request_ --- convert a list of parameters to a string that can be passed via GET/POST -toParams :: [(String, String)] -> String -toParams = show . UE.importList + -- D.trace (B.unpack . rspPayload $ response) (return ()) + let value = eitherDecode . rspPayload $ response + return $ rdioResult <$> value --- convert JSON str to parsed -toJSON str = fromResult $ (J.decode str :: J.Result (RdioResult)) +-- RDIO methods --- given a list of tuples, return a string that's a JSON object: -jsonify_tuples t = (++"}") . init $ foldl (\acc (k, v) -> acc ++ k ++ ":" ++ v ++ ",") "{" t +-- CORE methods TODO they all have multiple return types. -fromResult (J.Ok x) = x -fromResult (J.Error x) = error x +-- TODO currently unsupported because it has a variable specification. +-- All you can really do is request an Object back. --- if the first parameter is a Just, then return the second parameter --- otherwise return an empty list -addMaybe (Just a) b = b -addMaybe Nothing b = [] +-- | Takes: [keys], [extras] (optional) +get :: (Show a, FromJSON a) => [String] -> [String] -> Rdio (Either String a) +get keys extras = runRequest $ [("method", "get"), ("keys", toParam keys), ("extras", toParam extras)] --- needed b/c haskell capitalizes the first letter otherwise -bool_to_s True = "true" -bool_to_s False = "false" +-- | Takes: short code (everything after the http://rd.io/x/), [extras] +-- (optional) +getObjectFromShortCode :: (Show a, FromJSON a) => String -> [String] -> Rdio (Either String a) +getObjectFromShortCode shortCode extras = runRequest $ [("method", "getObjectFromShortCode"), ("short_code", shortCode), ("extras", toParam extras)] --- uses the Reader monad to get a token. Then uses that token --- to make a request to the service url. The returned response --- is parsed through extractResponse to return the result parsed --- from JSON to something else. -runRequest params = do - tok <- ask - liftM extractResponse $ runOAuthM tok $ signRq2 HMACSHA1 Nothing (srvUrl (B.pack . toParams $ params)) >>= serviceRequest CurlClient +-- | Takes: url (everything after http://rdio.com/), [extras] (optional) +getObjectFromUrl :: (Show a, FromJSON a) => String -> [String] -> Rdio (Either String a) +getObjectFromUrl url extras = runRequest $ [("method", "getObjectFromUrl"), ("url", url), ("extras", toParam extras)] --- extracts just the response from whatever rdio returned -extractResponse = toJSON . B.unpack . rspPayload +-- CATALOG methods --- ADTs for RDIO +-- | Takes: a UPC code, [extras] (optional) +getAlbumsByUPC :: Int -> [AlbumExtra] -> Rdio (Either String [Album]) +getAlbumsByUPC upc extras = runRequest $ [("method", "getAlbumsByUPC"), ("upc", toParam upc), mkExtras extras] -data RdioScope = USER_SCOPE | FRIENDS_SCOPE | EVERYONE_SCOPE -data RdioSort = DATE_ADDED_SORT | PLAY_COUNT_SORT | ARTIST_SORT | NAME_SORT -data RdioObjectType = ARTISTS_OBJECT_TYPE | ALBUMS_OBJECT_TYPE -data RdioTime = THIS_WEEK_TIME | LAST_WEEK_TIME | TWO_WEEKS_TIME -data RdioResultType = ARTIST_RESULT_TYPE | ALBUM_RESULT_TYPE | TRACK_RESULT_TYPE | PLAYLIST_RESULT_TYPE -data RdioType = ARTIST_TYPE | ALBUM_TYPE | TRACK_TYPE | PLAYLIST_TYPE | USER_TYPE -data RdioCollaborationMode = NO_COLLABORATION | COLLABORATION_WITH_ALL | COLLABORATION_WITH_FOLLOWED +-- | Takes: A key of an artist +getAlbumsForArtist :: String -> Rdio (Either String [Album]) +getAlbumsForArtist artist = getAlbumsForArtist' artist Nothing [] Nothing Nothing --- RDIO methods +getAlbumsForArtist' :: String -> Maybe Bool -> [AlbumExtra] -> Maybe Int -> Maybe Int -> Rdio (Either String [Album]) +getAlbumsForArtist' artist featuring extras start count = + runRequest $ [("method", "getAlbumsForArtist"), ("artist", artist), mkExtras extras] + <+> ("featuring", featuring) + <+> ("start", start) + <+> ("count", count) --- CORE methods -get keys extras options = runRequest $ [("method", "get"), ("keys", U.join "," keys)] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) ++ (addMaybe options [("options", jsonify_tuples $ fromJust options)]) +-- | Takes: a key of a label +getAlbumsForLabel :: String -> Rdio (Either String [Album]) +getAlbumsForLabel label = getAlbumsForLabel' label [] Nothing Nothing -getObjectFromShortCode short_code extras = runRequest $ [("method", "getObjectFromShortCode"), ("short_code", short_code)] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +getAlbumsForLabel' :: String -> [AlbumExtra] -> Maybe Int -> Maybe Int -> Rdio (Either String [Album]) +getAlbumsForLabel' label extras start count = + runRequest $ [("method", "getAlbumsForLabel"), ("label", label), mkExtras extras] + <+> ("start", start) + <+> ("count", count) -getObjectFromUrl url extras = runRequest $ [("method", "getObjectFromUrl"), ("url", url)] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +-- | Takes: a key of a label +getArtistsForLabel :: String -> Rdio (Either String [Artist]) +getArtistsForLabel label = getArtistsForLabel' label [] Nothing Nothing --- CATALOG methods -getAlbumsByUPC upc extras = runRequest $ [("method", "getAlbumsByUPC"), ("upc", upc)] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +getArtistsForLabel' :: String -> [ArtistExtra] -> Maybe Int -> Maybe Int -> Rdio (Either String [Artist]) +getArtistsForLabel' label extras start count = + runRequest $ [("method", "getArtistsForLabel"), ("label", label), mkExtras extras] + <+> ("start", start) + <+> ("count", count) -getAlbumsForArtist artist featuring extras start count = runRequest $ [("method", "getAlbumsForArtist"), ("artist", artist)] ++ (addMaybe featuring [("featuring", (bool_to_s $ fromJust featuring))]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) ++ (addMaybe start [("start", show $ fromJust start)]) ++ (addMaybe count [("count", show $ fromJust count)]) +-- | Takes: an ISRC code, [extras] (optional) +getTracksByISRC :: String -> [TrackExtra] -> Rdio (Either String [Track]) +getTracksByISRC isrc extras = runRequest $ [("method", "getTracksByISRC"), ("isrc", isrc), mkExtras extras] -getTracksByISRC isrc extras = runRequest $ [("method", "getTracksByISRC"), ("isrc", isrc)] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +-- | Takes: an artist key +getTracksForArtist :: String -> Rdio (Either String [Track]) +getTracksForArtist artist = getTracksForArtist' artist Nothing [] Nothing Nothing -getTracksForArtist artist appears_on start count extras = runRequest $ [("method", "getTracksForArtist"), ("artist", artist)] ++ (addMaybe appears_on [("appears_on", bool_to_s $ fromJust appears_on)]) ++ (addMaybe start [("start", show $ fromJust start)]) ++ (addMaybe count [("count", show $ fromJust count)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +getTracksForArtist' :: String -> Maybe Bool -> [TrackExtra] -> Maybe Int -> Maybe Int -> Rdio (Either String [Track]) +getTracksForArtist' artist appears_on extras start count = + runRequest $ [("method", "getTracksForArtist"), ("artist", artist), mkExtras extras] + <+> ("appears_on", appears_on) + <+> ("start", start) + <+> ("count", count) -search query types never_or extras start count = runRequest $ [("method", "search"), ("query", query), ("types", U.join "," (map pretty types))] ++ (addMaybe never_or [("never_or", bool_to_s $ fromJust never_or)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) ++ (addMaybe start [("start", show $ fromJust start)]) ++ (addMaybe count [("count", show $ fromJust count)]) - where pretty ARTIST_TYPE = "Artist" - pretty ALBUM_TYPE = "Album" - pretty TRACK_TYPE = "Track" - pretty PLAYLIST_TYPE = "Playlist" - pretty USER_TYPE = "User" +-- TODO this should also have an extras field but how to implement that and +-- still be able to return a generic type? +-- | Takes: a query, a type (\"Artist\", \"Album\", \"Track\", \"Playlist\", or +-- \"User\") +-- This method can return any of those types, so you need to specify what +-- you want returned. Example: +-- +-- > search "Radiohead" "Artist" :: Rdio (Either String [Artist]) +search :: (Show a, FromJSON a) => String -> String -> Rdio (Either String [a]) +search query types = search' query types Nothing Nothing Nothing -searchSuggestions query extras = runRequest $ [("method", "searchSuggestions"), ("query", query)] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +search' :: (Show a, FromJSON a) => String -> String -> Maybe Bool -> Maybe Int -> Maybe Int -> Rdio (Either String [a]) +search' query types neverOr start count = do + res <- runRequest $ [("method", "search"), ("query", query), ("types", types)] + <+> ("never_or", neverOr) + <+> ("start", start) + <+> ("count", count) --- COLLECTION methods -addToCollection keys = runRequest [("method", "addToCollection"), ("keys", U.join "," keys)] + return (results <$> res) -getAlbumsForArtistInCollection artist user extras = runRequest $ [("method", "getAlbumsForArtistInCollection"),("artist", artist)] ++ (addMaybe user [("user", fromJust user)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +-- TODO searchSuggestions -getAlbumsInCollection user start count sort query extras = runRequest $ [("method", "getAlbumsInCollection")] ++ (addMaybe user [("user", fromJust user)]) ++ (addMaybe start [("start", show $ fromJust start)]) ++ (addMaybe count [("count", show $ fromJust count)]) ++ (addMaybe sort [("sort", pretty $ fromJust sort)]) ++ (addMaybe query [("query", fromJust query)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) - where pretty DATE_ADDED_SORT = "dateAdded" - pretty PLAY_COUNT_SORT = "playCount" - pretty ARTIST_SORT = "artist" - pretty NAME_SORT = "name" +-- | Takes: a list of keys of tracks or playlists. *Requires +-- authentication*. +addToCollection :: [String] -> Rdio (Either String Object) +addToCollection keys = runRequest $ [("method", "addToCollection"), ("keys", toParam keys)] -getArtistsInCollection :: (MonadReader Token m, MonadIO m) => Maybe String -> Maybe Int -> Maybe Int -> Maybe RdioSort -> Maybe String -> Maybe [String] -> m (RdioResult) -getArtistsInCollection user start count sort query extras = runRequest $ [("method", "getArtistsInCollection")] ++ (addMaybe user [("user", fromJust user)]) ++ (addMaybe start [("start", show $ fromJust start)]) ++ (addMaybe count [("count", show $ fromJust count)]) ++ (addMaybe sort [("sort", pretty $ fromJust sort)]) ++ (addMaybe query [("query", fromJust query)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) - where pretty DATE_ADDED_SORT = "dateAdded" - pretty PLAY_COUNT_SORT = "playCount" - pretty ARTIST_SORT = "artist" - pretty NAME_SORT = "name" +-- | Takes: an artist key. Requires authentication OR use @getAlbumsForArtistInCollection'@ and pass in a user key. +getAlbumsForArtistInCollection :: String -> Rdio (Either String [Album]) +getAlbumsForArtistInCollection artist = getAlbumsForArtistInCollection' artist Nothing [] Nothing -getTracksForAlbumInCollection album user extras = runRequest $ [("method", "getTracksForAlbumInCollection"), ("album", album)] ++ (addMaybe user [("user", fromJust user)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +getAlbumsForArtistInCollection' :: String -> Maybe String -> [AlbumExtra] -> Maybe String -> Rdio (Either String [Album]) +getAlbumsForArtistInCollection' artist user extras sort = + runRequest $ [("method", "getAlbumsForArtistInCollection"), ("artist", artist), mkExtras extras] + <+> ("user", user) + <+> ("sort", sort) -getTracksForArtistInCollection artist user extras = runRequest $ [("method", "getTracksForArtistInCollection"), ("artist", artist)] ++ (addMaybe user [("user", fromJust user)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +-- | Requires authentication OR use @getAlbumsInCollection'@ and pass in +-- a user key. +getAlbumsInCollection :: Rdio (Either String [Album]) +getAlbumsInCollection = getAlbumsInCollection' Nothing Nothing Nothing Nothing Nothing [] -getTracksInCollection :: (MonadReader Token m, MonadIO m) => Maybe String -> Maybe Int -> Maybe Int -> Maybe RdioSort -> Maybe String -> Maybe [String] -> m (RdioResult) -getTracksInCollection user start count sort query extras = runRequest $ [("method", "getTracksInCollection")] ++ (addMaybe user [("user", fromJust user)]) ++ (addMaybe start [("start", show $ fromJust start)]) ++ (addMaybe count [("count", show $ fromJust count)]) ++ (addMaybe sort [("sort", pretty $ fromJust sort)]) ++ (addMaybe query [("query", fromJust query)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) - where pretty DATE_ADDED_SORT = "dateAdded" - pretty PLAY_COUNT_SORT = "playCount" - pretty ARTIST_SORT = "artist" - pretty NAME_SORT = "name" +getAlbumsInCollection' :: Maybe String -> Maybe Int -> Maybe Int -> Maybe String -> Maybe String -> [AlbumExtra] -> Rdio (Either String [Album]) +getAlbumsInCollection' user start count sort query extras = + runRequest $ [("method", "getAlbumsInCollection"), mkExtras extras] + <+> ("user", user) + <+> ("start", start) + <+> ("count", count) + <+> ("sort", sort) + <+> ("query", query) -removeFromCollection keys = runRequest [("method", "removeFromCollection"), ("keys", U.join "," keys)] +-- | Requires authentication OR use @getArtistsInCollection'@ and pass in +-- a user key. +getArtistsInCollection :: Rdio (Either String [Artist]) +getArtistsInCollection = getArtistsInCollection' Nothing Nothing Nothing Nothing Nothing [] -setAvailableOffline :: (MonadReader Token m, MonadIO m) => [[Char]] -> Bool -> m (RdioResult) -setAvailableOffline keys offline = runRequest [("method", "setAvailableOffline"), ("keys", U.join "," keys), ("offline", (bool_to_s offline))] +getArtistsInCollection' :: Maybe String -> Maybe Int -> Maybe Int -> Maybe String -> Maybe String -> [ArtistExtra] -> Rdio (Either String [Artist]) +getArtistsInCollection' user start count sort query extras = + runRequest $ [("method", "getArtistsInCollection"), mkExtras extras] + <+> ("user", user) + <+> ("start", start) + <+> ("count", count) + <+> ("sort", sort) + <+> ("query", query) --- PLAYLIST methods -addToPlaylist playlist tracks = runRequest [("method", "addToPlaylist"), ("playlist", playlist), ("tracks", U.join "," tracks)] +-- | Requires authentication. +getOfflineTracks :: Rdio (Either String [Track]) +getOfflineTracks = getOfflineTracks' Nothing Nothing [] -createPlaylist name description tracks extras = runRequest $ [("method", "createPlaylist"), ("name", name), ("description", description), ("tracks", U.join "," tracks)] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +getOfflineTracks' :: Maybe Int -> Maybe Int -> [TrackExtra] -> Rdio (Either String [Track]) +getOfflineTracks' start count extras = + runRequest $ [("method", "getOfflineTracks"), mkExtras extras] + <+> ("start", start) + <+> ("count", count) -deletePlaylist playlist = runRequest [("method", "deletePlaylist"), ("playlist", playlist)] +-- | Takes: an album key. Requires authentication OR use @getTracksForAlbumInCollection'@ and pass in a user key. +getTracksForAlbumInCollection :: String -> Rdio (Either String [Track]) +getTracksForAlbumInCollection album = getTracksForAlbumInCollection' album Nothing [] -getPlaylists extras = runRequest $ [("method", "getPlaylists")] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +getTracksForAlbumInCollection' :: String -> Maybe String -> [TrackExtra] -> Rdio (Either String [Track]) +getTracksForAlbumInCollection' album user extras = + runRequest $ [("method", "getTracksForAlbumInCollection"), ("album", album), mkExtras extras] + <+> ("user", user) -removeFromPlaylist :: (MonadReader Token m, MonadIO m) => String -> Int -> Int -> [[Char]] -> m (RdioResult) -removeFromPlaylist playlist index count tracks = runRequest [("method", "removeFromPlaylist"), ("playlist", playlist), ("index", (show index)), ("count", (show count)), ("tracks", U.join "," tracks)] +-- | Takes: an artist key. Requires authentication OR use @getTracksForArtistInCollection'@ and pass in a user key. +getTracksForArtistInCollection :: String -> Rdio (Either String [Track]) +getTracksForArtistInCollection artist = getTracksForArtistInCollection' artist Nothing [] -setPlaylistCollaborating :: (MonadReader Token m, MonadIO m) => String -> Bool -> m (RdioResult) -setPlaylistCollaborating playlist collaborating = runRequest [("method", "setPlaylistCollaborating"), ("playlist", playlist), ("collaborating", (bool_to_s collaborating))] +getTracksForArtistInCollection' :: String -> Maybe String -> [TrackExtra] -> Rdio (Either String [Track]) +getTracksForArtistInCollection' artist user extras = + runRequest $ [("method", "getTracksForArtistInCollection"), ("artist", artist), mkExtras extras] + <+> ("user", user) -setPlaylistCollaborationMode :: (MonadReader Token m, MonadIO m) => String -> RdioCollaborationMode -> m (RdioResult) -setPlaylistCollaborationMode playlist mode = runRequest [("method", "setPlaylistCollaborationMode"), ("playlist", playlist), ("mode", (pretty mode))] - where pretty NO_COLLABORATION = "0" - pretty COLLABORATION_WITH_ALL = "1" - pretty COLLABORATION_WITH_FOLLOWED = "2" +-- | Requires authentication OR use @getTracksInCollection'@ and pass in +-- a user key. +getTracksInCollection :: Rdio (Either String [Track]) +getTracksInCollection = getTracksInCollection' Nothing Nothing Nothing Nothing Nothing [] -setPlaylistFields playlist name description = runRequest [("method", "setPlaylistFields"), ("playlist", playlist), ("name", name), ("description", description)] +getTracksInCollection' :: Maybe String -> Maybe Int -> Maybe Int -> Maybe String -> Maybe String -> [TrackExtra] -> Rdio (Either String [Track]) +getTracksInCollection' user start count sort query extras = + runRequest $ [("method", "getTracksInCollection"), mkExtras extras] + <+> ("user", user) + <+> ("start", start) + <+> ("count", count) + <+> ("sort", sort) + <+> ("query", query) -setPlaylistOrder playlist tracks = runRequest [("method", "setPlaylistOrder"), ("playlist", playlist), ("tracks", U.join "," tracks)] +-- | Takes: a list of track or playlist keys. Requires authentication. +removeFromCollection :: [String] -> Rdio (Either String Bool) +removeFromCollection keys = runRequest $ [("method", "removeFromCollection"), ("keys", toParam keys)] --- SOCIAL NETWORK methods -addFriend user = runRequest [("method", "addFriend"), ("user", user)] +-- | Takes: a list of track or playlist keys. Requires authentication. +setAvailableOffline :: [String] -> Bool -> Rdio (Either String Object) +setAvailableOffline keys offline = runRequest $ [("method", "setAvailableOffline"), ("keys", toParam keys), ("offline", toParam offline)] -currentUser extras = runRequest $ [("method", "currentUser")] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +-- | Takes: a playlist key, a list of track keys to add to the playlist, +-- [extras] (optional). +-- Requires authentication. +addToPlaylist :: String -> [String] -> [PlaylistExtra] -> Rdio (Either String Playlist) +addToPlaylist playlist tracks extras = runRequest $ [("method", "addToPlaylist"), ("playlist", playlist), ("tracks", toParam tracks), mkExtras extras] -findUserByEmail email extras = runRequest $ [("method", "findUser"), ("email", email)] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +-- | Takes: a name, a description, a list of track keys to start the +-- playlist with, [extras] (optional). Requires authentication. +createPlaylist :: String -> String -> [String] -> [PlaylistExtra] -> Rdio (Either String Playlist) +createPlaylist name description tracks extras = + runRequest $ [("method", "createPlaylist"), ("name", name), ("description", description), ("tracks", toParam tracks), mkExtras extras] -findUserByVanityName vanityName extras = runRequest $ [("method", "findUser"), ("vanityName", vanityName)] ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +-- | Takes: a playlist key. Requires authentication. +deletePlaylist :: String -> Rdio (Either String Bool) +deletePlaylist playlist = runRequest $ [("method", "deletePlaylist"), ("playlist", playlist)] -removeFriend user = runRequest [("method", "removeFriend"), ("user", user)] +-- | Requires authentication OR use @getPlaylists'@ and pass in a user key. +getPlaylists :: Rdio (Either String UserPlaylists) +getPlaylists = getPlaylists' Nothing [] Nothing -userFollowers :: (MonadReader Token m, MonadIO m) => String -> Maybe Int -> Maybe Int -> Maybe [String] -> m (RdioResult) -userFollowers user start count extras = runRequest $ [("method", "userFollowers"), ("user", user)] ++ (addMaybe start [("start", show start)]) ++ (addMaybe count [("count", show $ fromJust count)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +getPlaylists' :: Maybe String -> [PlaylistExtra] -> Maybe Bool -> Rdio (Either String UserPlaylists) +getPlaylists' user extras orderedList = + runRequest $ [("method", "getPlaylists"), mkExtras extras] + <+> ("user", user) + <+> ("ordered_list", orderedList) -userFollowing :: (MonadReader Token m, MonadIO m) => String -> Maybe Int -> Maybe Int -> Maybe [String] -> m (RdioResult) -userFollowing user start count extras = runRequest $ [("method", "userFollowing"), ("user", user)] ++ (addMaybe start [("start", show $ fromJust start)]) ++ (addMaybe count [("count", show $ fromJust count)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) +-- | Requires authentication OR use @getUserPlaylists'@ and pass in a user key. +getUserPlaylists :: String -> Rdio (Either String [Playlist]) +getUserPlaylists user = getUserPlaylists' user Nothing Nothing Nothing Nothing [] --- ACTIVITY AND STATISTICS methods +getUserPlaylists' :: String -> Maybe PlaylistType -> Maybe String -> Maybe Int -> Maybe Int -> [PlaylistExtra] -> Rdio (Either String [Playlist]) +getUserPlaylists' user kind sort start count extras = + runRequest $ [("method", "getUserPlaylists"), ("user", user), mkExtras extras] + <+> ("kind", kind) + <+> ("sort", sort) + <+> ("start", start) + <+> ("count", count) -getActivityStream user scope last_id extras = runRequest $ [("method", "getActivityStream"), ("scope", (pretty scope))] ++ (addMaybe last_id [("last_id", fromJust last_id)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) - where pretty USER_SCOPE = "user" - pretty FRIENDS_SCOPE = "friends" - pretty EVERYONE_SCOPE = "everyone" +-- | Takes: +-- - a playlist key +-- +-- - the index of the first item to remove +-- +-- - number of tracks to remove +-- +-- - the keys of the tracks to remove (redundancy to prevent accidental +-- deletion) +-- +-- - [extras] (optional) +-- +-- Requires authentication. +removeFromPlaylist :: String -> Int -> Int -> Int -> [PlaylistExtra] -> Rdio (Either String Playlist) +removeFromPlaylist playlist index count tracks extras = + runRequest $ [("method", "removeFromPlaylist"), ("playlist", playlist), ("index", toParam index), ("count", toParam count), ("tracks", toParam tracks), mkExtras extras] -getHeavyRotation :: (MonadReader Token m, MonadIO m) => Maybe String -> Maybe RdioObjectType -> Maybe Bool -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe [String] -> m (RdioResult) -getHeavyRotation user object_type friends limit start count extras = runRequest $ [("method", "getHeavyRotation")] ++ (addMaybe user [("user", fromJust user)]) ++ (addMaybe object_type [("object_type", pretty $ fromJust object_type)]) ++ (addMaybe friends [("friends", bool_to_s $ fromJust friends)]) ++ (addMaybe limit [("limit", show $ fromJust limit)]) ++ (addMaybe start [("start", show $ fromJust start)]) ++ (addMaybe count [("count", show $ fromJust count)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) - where pretty ARTISTS_OBJECT_TYPE = "artist" - pretty ALBUMS_OBJECT_TYPE = "albums" +-- | Takes: a playlist key, a boolean (true == collaborating, false == not +-- collaborating). Requires authentication. +setPlaylistCollaborating :: String -> Bool -> Rdio (Either String Bool) +setPlaylistCollaborating playlist collaborating = + runRequest $ [("method", "setPlaylistCollaborating"), ("playlist", playlist), ("collaborating", toParam collaborating)] -getNewReleases :: (MonadReader Token m, MonadIO m) => Maybe RdioTime -> Maybe Int -> Maybe Int -> Maybe [String] -> m (RdioResult) -getNewReleases time start count extras = runRequest $ [("method", "getNewReleases")] ++ (addMaybe time [("time", pretty $ fromJust time)]) ++ (addMaybe start [("start", show $ fromJust start)]) ++ (addMaybe count [("count", show $ fromJust count)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) - where pretty THIS_WEEK_TIME = "thisweek" - pretty LAST_WEEK_TIME = "lastweek" - pretty TWO_WEEKS_TIME = "twoweeks" +-- | Takes: a playlist key, a collaboration mode. Requires authentication. +setPlaylistCollaborationMode :: String -> CollaborationMode -> Rdio (Either String Bool) +setPlaylistCollaborationMode playlist mode = + runRequest $ [("method", "setPlaylistCollaborationMode"), ("playlist", playlist), ("mode", toParam mode)] -getTopCharts :: (MonadReader Token m, MonadIO m) => RdioResultType -> Maybe Int -> Maybe Int -> Maybe [String] -> m (RdioResult) -getTopCharts result_type start count extras = runRequest $ [("method", "getTopCharts"), ("result_type", (pretty result_type))] ++ (addMaybe start [("start", show $ fromJust start)]) ++ (addMaybe count [("count", show $ fromJust count)]) ++ (addMaybe extras [("extras", U.join "," $ fromJust extras)]) - where pretty ARTIST_RESULT_TYPE = "Artist" - pretty ALBUM_RESULT_TYPE = "Album" - pretty TRACK_RESULT_TYPE = "Track" - pretty PLAYLIST_RESULT_TYPE = "Playlist" +-- | Takes: a playlist key, a name, a description. Requires authentication. +setPlaylistFields :: String -> String -> String -> Rdio (Either String Bool) +setPlaylistFields playlist name description = + runRequest $ [("method", "setPlaylistFields"), ("playlist", playlist), ("name", name), ("description", description)] --- PLAYBACK methods -getPlaybackToken domain = runRequest $ [("method", "getPlaybackToken")] ++ (addMaybe domain [("domain", fromJust domain)]) +-- | Takes: a playlist key, a list of track keys, [extras] (optional). +-- Requires authentication. +setPlaylistOrder :: String -> [String] -> [PlaylistExtra] -> Rdio (Either String Playlist) +setPlaylistOrder playlist tracks extras = + runRequest $ [("method", "setPlaylistOrder"), ("playlist", playlist), ("tracks", toParam tracks), mkExtras extras] +-- | Takes: a user key. Requires authentication. +addFriend :: String -> Rdio (Either String Bool) +addFriend user = runRequest $ [("method", "addFriend"), ("user", user)] +-- | Requires authentication. +currentUser :: [UserExtra] -> Rdio (Either String User) +currentUser extras = runRequest $ [("method", "currentUser"), mkExtras extras] + +-- | Takes: an email address, [extras] (optional). +findUserByEmail :: String -> [UserExtra] -> Rdio (Either String User) +findUserByEmail email extras = runRequest $ [("method", "findUser"), ("email", email), mkExtras extras] + +-- | Takes: user name, [extras] (optional). +findUserByName :: String -> [UserExtra] -> Rdio (Either String User) +findUserByName vanityName extras = runRequest $ [("method", "findUser"), ("vanityName", vanityName), mkExtras extras] + +-- | Takes: a user key. Requires authentication. +removeFriend :: String -> Rdio (Either String Bool) +removeFriend user = runRequest $ [("method", "removeFriend"), ("user", user)] + +-- | Takes: a user key. +userFollowers :: String -> Rdio (Either String [User]) +userFollowers user = userFollowers' user Nothing Nothing [] Nothing + +userFollowers' :: String -> Maybe Int -> Maybe Int -> [UserExtra] -> Maybe String -> Rdio (Either String [User]) +userFollowers' user start count extras inCommon = + runRequest $ [("method", "userFollowers"), ("user", user), mkExtras extras] + <+> ("start", start) + <+> ("count", count) + <+> ("inCommon", inCommon) + +-- | Takes: a user key. +userFollowing :: String -> Rdio (Either String [User]) +userFollowing user = userFollowing' user Nothing Nothing [] Nothing + +userFollowing' :: String -> Maybe Int -> Maybe Int -> [UserExtra] -> Maybe String -> Rdio (Either String [User]) +userFollowing' user start count extras inCommon = + runRequest $ [("method", "userFollowing"), ("user", user), mkExtras extras] + <+> ("start", start) + <+> ("count", count) + <+> ("inCommon", inCommon) + + +-- TODO extras not implemented here because I don't know what it means in +-- this context. Also, the docs say there will be additional data depending +-- on the update_type. Without specifying crap. So this is incomplete for +-- now. + +-- | Takes: a user key, a scope. +getActivityStream :: String -> Scope -> Rdio (Either String Activity) +getActivityStream user scope = getActivityStream' user scope Nothing Nothing + +getActivityStream' :: String -> Scope -> Maybe Int -> Maybe Int -> Rdio (Either String Activity) +getActivityStream' user scope lastId count = + runRequest $ [("method", "getActivityStream"), ("user", user), ("scope", toParam scope)] + <+> ("last_id", lastId) + <+> ("count", count) + +getHeavyRotationArtists :: Rdio (Either String [Artist]) +getHeavyRotationArtists = getHeavyRotationArtists' Nothing Nothing Nothing Nothing Nothing [] + +getHeavyRotationArtists' :: Maybe String -> Maybe Bool -> Maybe Int -> Maybe Int -> Maybe Int -> [ArtistExtra] -> Rdio (Either String [Artist]) +getHeavyRotationArtists' user friends limit start count extras = + runRequest $ [("method", "getHeavyRotation"), ("type", "artists"), mkExtras extras] + <+> ("user", user) + <+> ("friends", friends) + <+> ("limit", limit) + <+> ("start", start) + <+> ("count", count) + +getHeavyRotationAlbums :: Rdio (Either String [Album]) +getHeavyRotationAlbums = getHeavyRotationAlbums' Nothing Nothing Nothing Nothing Nothing [] + +getHeavyRotationAlbums' :: Maybe String -> Maybe Bool -> Maybe Int -> Maybe Int -> Maybe Int -> [AlbumExtra] -> Rdio (Either String [Album]) +getHeavyRotationAlbums' user friends limit start count extras = + runRequest $ [("method", "getHeavyRotation"), ("type", "artists"), mkExtras extras] + <+> ("user", user) + <+> ("friends", friends) + <+> ("limit", limit) + <+> ("start", start) + <+> ("count", count) + +getNewReleases :: Rdio (Either String [Album]) +getNewReleases = getNewReleases' Nothing Nothing Nothing [] + +getNewReleases' :: Maybe Timeframe -> Maybe Int -> Maybe Int -> [AlbumExtra] -> Rdio (Either String [Album]) +getNewReleases' time start count extras = + runRequest $ [("method", "getNewReleases"), mkExtras extras] + <+> ("time", time) + <+> ("start", start) + <+> ("count", count) + +getTopChartArtists :: Rdio (Either String [Artist]) +getTopChartArtists = getTopChartArtists' Nothing Nothing [] + +getTopChartArtists' :: Maybe Int -> Maybe Int -> [ArtistExtra] -> Rdio (Either String [Artist]) +getTopChartArtists' start count extras = + runRequest $ [("method", "getTopCharts"), ("type", "Artist"), mkExtras extras] + <+> ("start", start) + <+> ("count", count) + +getTopChartAlbums :: Rdio (Either String [Album]) +getTopChartAlbums = getTopChartAlbums' Nothing Nothing [] + +getTopChartAlbums' :: Maybe Int -> Maybe Int -> [AlbumExtra] -> Rdio (Either String [Album]) +getTopChartAlbums' start count extras = + runRequest $ [("method", "getTopCharts"), ("type", "Album"), mkExtras extras] + <+> ("start", start) + <+> ("count", count) + + +getTopChartTracks :: Rdio (Either String [Track]) +getTopChartTracks = getTopChartTracks' Nothing Nothing [] + +getTopChartTracks' :: Maybe Int -> Maybe Int -> [TrackExtra] -> Rdio (Either String [Track]) +getTopChartTracks' start count extras = + runRequest $ [("method", "getTopCharts"), ("type", "Track"), mkExtras extras] + <+> ("start", start) + <+> ("count", count) + + +getTopChartPlaylists :: Rdio (Either String [Playlist]) +getTopChartPlaylists = getTopChartPlaylists' Nothing Nothing [] + +getTopChartPlaylists' :: Maybe Int -> Maybe Int -> [PlaylistExtra] -> Rdio (Either String [Playlist]) +getTopChartPlaylists' start count extras = + runRequest $ [("method", "getTopCharts"), ("type", "Playlist"), mkExtras extras] + <+> ("start", start) + <+> ("count", count) + +-- | Takes: the domain that the playback SWF will be embedded in +-- (optional). +getPlaybackToken :: Maybe String -> Rdio (Either String String) +getPlaybackToken domain = runRequest $ [("method", "getPlaybackToken")] <+> ("domain", domain) diff --git a/src/Rdioh/Auth.hs b/src/Rdioh/Auth.hs new file mode 100644 --- /dev/null +++ b/src/Rdioh/Auth.hs @@ -0,0 +1,32 @@ +module Rdioh.Auth where +import Network.OAuth.Consumer +import Network.OAuth.Http.Request +import Network.OAuth.Http.Response +import Network.OAuth.Http.HttpClient +import Network.OAuth.Http.CurlHttpClient +import Network.OAuth.Http.PercentEncoding +import Data.Maybe +import Data.List +import Control.Monad.IO.Class + +reqUrl = fromJust . parseURL $ "http://api.rdio.com/oauth/request_token" +accUrl = fromJust . parseURL $ "http://api.rdio.com/oauth/access_token" +authUrl = ("https://www.rdio.com/oauth/authorize?oauth_token="++) . findWithDefault ("oauth_token","ERROR") . oauthParams +srvUrl payload = (fromJust . parseURL $ "http://api.rdio.com/1/") { method = POST + , reqPayload = payload + , reqHeaders = fromList [("content-type", "application/x-www-form-urlencoded")] + } + +app key secret = Application key secret OOB + +-- | Takes: a key and a secret. Returns a two-legged auth token. You can +-- just use @runRdio@ in most cases. +twoLegToken :: String -> String -> Token +twoLegToken key secret = fromApplication (app key secret) + +-- | Takes: a key and a secret. Does three-legged auth and returns an auth token. You can just use @runRdioWithAuth@ in most cases. +threeLegToken :: MonadIO m => String -> String -> m Token +threeLegToken key secret = runOAuthM (twoLegToken key secret) $ do + signRq2 HMACSHA1 Nothing reqUrl >>= oauthRequest CurlClient + cliAskAuthorization authUrl + signRq2 HMACSHA1 Nothing accUrl >>= oauthRequest CurlClient diff --git a/src/Rdioh/Models.hs b/src/Rdioh/Models.hs new file mode 100644 --- /dev/null +++ b/src/Rdioh/Models.hs @@ -0,0 +1,740 @@ +{-# LANGUAGE OverloadedStrings #-} + +{- +IDEA: all of these modles could have been split up into their own modules: +Rdioh.Model.Artist etc etc. +Then we wouldn't have these scoping issues and all the fields could be normal names. + +Downside: user has to import each module explicitly to use it. +-} + +module Rdioh.Models where +import Data.Aeson +import Control.Applicative + +data AlbumExtra = AlbumIframeUrl | AlbumIsCompilation | AlbumLabel | AlbumBigIcon | AlbumReleaseDateISO + +instance Show AlbumExtra where + show AlbumIframeUrl = "iframeUrl" + show AlbumIsCompilation = "isCompilation" + show AlbumLabel = "label" + show AlbumBigIcon = "bigIcon" + show AlbumReleaseDateISO = "releaseDateISO" + +data Album = Album { + albumName :: String, + albumIcon :: String, + albumBaseIcon :: String, + albumUrl :: String, + albumArtist :: String, + albumArtistUrl :: String, + isExplicit :: Bool, + isClean :: Bool, + albumLength :: Int, + albumArtistKey :: String, + trackKeys :: [String], + price :: String, + canStream :: Bool, + canSample :: Bool, + canTether :: Bool, + albumShortUrl :: String, + embedUrl :: String, + displayDate :: String, + albumKey :: String, + releaseDate :: String, + duration :: Int, + iframeUrl :: Maybe String, + isCompilation :: Maybe Bool, + albumLabel :: Maybe String, + albumBigIcon :: Maybe String, + releaseDateISO :: Maybe String +} deriving (Show) + +instance FromJSON Album where + parseJSON (Object v) = Album <$> v .: "name" + <*> v .: "icon" + <*> v .: "baseIcon" + <*> v .: "url" + <*> v .: "artist" + <*> v .: "artistUrl" + <*> v .: "isExplicit" + <*> v .: "isClean" + <*> v .: "length" + <*> v .: "artistKey" + <*> v .: "trackKeys" + <*> v .: "price" + <*> v .: "canStream" + <*> v .: "canSample" + <*> v .: "canTether" + <*> v .: "shortUrl" + <*> v .: "embedUrl" + <*> v .: "displayDate" + <*> v .: "key" + <*> v .: "releaseDate" + <*> v .: "duration" + <*> v .:? "iframeUrl" + <*> v .:? "isCompilation" + <*> v .:? "label" + <*> v .:? "bigIcon" + <*> v .:? "releaseDateISO" + +data ArtistExtra = ArtistAlbumCount + +instance Show ArtistExtra where + show ArtistAlbumCount = "albumCount" + +data Artist = Artist { + artistName :: String, + artistKey :: String, + artistUrl :: String, + artistLength :: Int, + artistIcon :: String, + artistBaseIcon :: String, + hasRadio :: Bool, + artistShortUrl :: String, + radioKey :: Maybe String, + topSongsKey :: Maybe String, + artistAlbumCount :: Maybe Int +} deriving (Show) + +instance FromJSON Artist where + parseJSON (Object v) = Artist <$> v .: "name" + <*> v .: "key" + <*> v .: "url" + <*> v .: "length" + <*> v .: "icon" + <*> v .: "baseIcon" + <*> v .: "hasRadio" + <*> v .: "shortUrl" + <*> v .:? "radioKey" + <*> v .:? "topSongsKey" + <*> v .:? "albumCount" + +data Label = Label { + labelName :: String, + labelKey :: String, + labelUrl :: String, + labelShortUrl :: String, + labelHasRadio :: Bool, + labelRadioKey :: String +} deriving (Show) + +instance FromJSON Label where + parseJSON (Object v) = Label <$> v .: "name" + <*> v .: "key" + <*> v .: "url" + <*> v .: "shortUrl" + <*> v .: "hasRadio" + <*> v .: "radioKey" + +data TrackExtra = IsInCollection | IsOnCompilation | Isrcs | TrackIframeUrl | PlayCount | TrackBigIcon + +instance Show TrackExtra where + show IsInCollection = "isInCollection" + show IsOnCompilation = "isOnCompilation" + show Isrcs = "isrcs" + show TrackIframeUrl = "iframeUrl" + show PlayCount = "playCount" + show TrackBigIcon = "bigIcon" + +data Track = Track { + trackName :: String, + trackArtist :: String, + trackAlbum :: String, + trackAlbumKey :: String, + trackAlbumUrl :: String, + trackArtistKey :: String, + trackArtistUrl :: String, + trackDuration :: Int, + trackIsExplicit :: Bool, + trackIsClean :: Bool, + trackUrl :: String, + trackBaseIcon :: String, + trackCanDownload :: Bool, + trackCanDownloadAlbumOnly :: Bool, + trackCanStream :: Bool, + trackCanTether :: Bool, + trackCanSample :: Bool, + trackPrice :: String, + trackEmbedUrl :: String, + trackKey :: String, + trackIcon :: String, + trackNum :: Int, + trackAlbumArtist :: Maybe String, + trackAlbumArtistKey :: Maybe String, + isInCollection :: Maybe Bool, + isOnCompilation :: Maybe Bool, + isrcs :: Maybe [String], + trackIframeUrl :: Maybe String, + playCount :: Maybe Int, + trackBigIcon :: Maybe String +} deriving (Show) + +instance FromJSON Track where + parseJSON (Object v) = Track <$> v .: "name" + <*> v .: "artist" + <*> v .: "album" + <*> v .: "albumKey" + <*> v .: "albumUrl" + <*> v .: "artistKey" + <*> v .: "artistUrl" + <*> v .: "duration" + <*> v .: "isExplicit" + <*> v .: "isClean" + <*> v .: "url" + <*> v .: "baseIcon" + <*> v .: "canDownload" + <*> v .: "canDownloadAlbumOnly" + <*> v .: "canStream" + <*> v .: "canTether" + <*> v .: "canSample" + <*> v .: "price" + <*> v .: "embedUrl" + <*> v .: "key" + <*> v .: "icon" + <*> v .: "trackNum" + <*> v .:? "albumArtist" + <*> v .:? "albumArtistKey" + <*> v .:? "isInCollection" + <*> v .:? "isOnCompilation" + <*> v .:? "isrcs" + <*> v .:? "iframeUrl" + <*> v .:? "playCount" + <*> v .:? "bigIcon" + +data Reason = Viewable | UserPreference | OrderedAlbum | TooFewSongs deriving (Show) + +instance FromJSON Reason where + parseJSON (Number n) + | n == 0 = return Viewable + | n == 1 = return UserPreference + | n == 2 = return OrderedAlbum + | n == 3 = return TooFewSongs + +data PlaylistExtra = PlIframeUrl | IsViewable | PlBigIcon | PlDescription | PlTracks | IsPublished | PlTrackKeys | ReasonNotViewable + +instance Show PlaylistExtra where + show PlIframeUrl = "iframeUrl" + show IsViewable = "isViewable" + show PlBigIcon = "bigIcon" + show PlDescription = "description" + show PlTracks = "tracks" + show IsPublished = "isPublished" + show PlTrackKeys = "trackKeys" + show ReasonNotViewable = "reasonNotViewable" + +data Playlist = Playlist { + plName :: String, + plUrl :: String, + plOwner :: String, + plOwnerUrl :: String, + plOwnerKey :: String, + plOwnerIcon :: String, + plShortUrl :: String, + plEmbedUrl :: String, + plKey :: String, + plLength :: Maybe Int, + plIcon :: Maybe String, + plBaseIcon :: Maybe String, + lastUpdated :: Maybe Int, + plIFrameUrl :: Maybe String, + isViewable :: Maybe Bool, + plBigIcon :: Maybe String, + plDescription :: Maybe String, + plTracks :: Maybe [Track], + isPublished :: Maybe Bool, + plTrackKeys :: Maybe [String], + reasonNotViewable :: Maybe Reason +} deriving (Show) + +instance FromJSON Playlist where + parseJSON (Object v) = Playlist <$> v .: "name" + <*> v .: "url" + <*> v .: "owner" + <*> v .: "ownerUrl" + <*> v .: "ownerKey" + <*> v .: "ownerIcon" + <*> v .: "shortUrl" + <*> v .: "embedUrl" + <*> v .: "key" + <*> v .:? "length" + <*> v .:? "icon" + <*> v .:? "baseIcon" + <*> v .:? "lastUpdated" + <*> v .:? "iframeUrl" + <*> v .:? "isViewable" + <*> v .:? "bigIcon" + <*> v .:? "description" + <*> v .:? "tracks" + <*> v .:? "isPublished" + <*> v .:? "trackKeys" + <*> v .:? "reasonNotViewable" + +data Gender = Male | Female deriving (Show) + +data UserPlaylists = UserPlaylists { + upOwned :: [Playlist], + upCollab :: [Playlist], + upSubscribed :: [Playlist] +} deriving (Show) + +instance FromJSON UserPlaylists where + parseJSON (Object v) = UserPlaylists <$> v .: "owned" + <*> v .: "collab" + <*> v .: "subscribed" + + +instance FromJSON Gender where + parseJSON (String s) = return (if s == "m" then Male else Female) + +data User = User { + userKey :: String, + firstName :: String, + lastName :: String, + userIcon :: String, + userBaseIcon :: String, + libraryVersion :: Int, + userUrl :: String, + gender :: Gender, + followingUrl :: Maybe String, + isTrial :: Maybe Bool, + artistCount :: Maybe Int, + lastSongPlayed :: Maybe String, + heavyRotationKey :: Maybe String, + networkHeavyRotationKey :: Maybe String, + albumCount :: Maybe Int, + trackCount :: Maybe Int, + lastSongPlayTime :: Maybe String, + username :: Maybe String, + reviewCount :: Maybe Int, + collectionUrl :: Maybe String, + playlistsUrl :: Maybe String, + collectionKey :: Maybe String, + followersUrl :: Maybe String, + displayName :: Maybe String, + isUnlimited :: Maybe Bool, + isSubscriber :: Maybe Bool +} deriving (Show) + +data UserExtra = FollowingUrl | IsTrial | ArtistCount | LastSongPlayed | HeavyRotationKey | NetworkHeavyRotationKey | AlbumCount | TrackCount | LastSongPlayTime | Username | ReviewCount | CollectionUrl | PlaylistsUrl | CollectionKey | FollowersUrl | DisplayName | IsUnlimited | IsSubscriber + +instance Show UserExtra where + show FollowingUrl = "followingUrl" + show IsTrial = "isTrial" + show ArtistCount = "artistCount" + show LastSongPlayed = "lastSongPlayed" + show HeavyRotationKey = "heavyRotationKey" + show NetworkHeavyRotationKey = "networkHeavyRotationKey" + show AlbumCount = "albumCount" + show TrackCount = "trackCount" + show LastSongPlayTime = "lastSongPlayTime" + show Username = "username" + show ReviewCount = "reviewCount" + show CollectionUrl = "collectionUrl" + show PlaylistsUrl = "playlistsUrl" + show CollectionKey = "collectionkey" + show FollowersUrl = "followersUrl" + show DisplayName = "displayName" + show IsUnlimited = "isUnlimited" + show IsSubscriber = "isSubscriber" + +instance FromJSON User where + parseJSON (Object v) = User <$> v .: "key" + <*> v .: "firstName" + <*> v .: "lastName" + <*> v .: "icon" + <*> v .: "baseIcon" + <*> v .: "libraryVersion" + <*> v .: "url" + <*> v .: "gender" + <*> v .:? "followingUrl" + <*> v .:? "isTrial" + <*> v .:? "artistCount" + <*> v .:? "lastSongPlayed" + <*> v .:? "heavyRotationKey" + <*> v .:? "networkHeavyRotationKey" + <*> v .:? "albumCount" + <*> v .:? "trackCount" + <*> v .:? "lastSongPlayTime" + <*> v .:? "username" + <*> v .:? "reviewCount" + <*> v .:? "collectionUrl" + <*> v .:? "playlistsUrl" + <*> v .:? "collectionKey" + <*> v .:? "followersUrl" + <*> v .:? "displayName" + <*> v .:? "isUnlimited" + <*> v .:? "isSubscriber" + +data CollectionAlbum = CollectionAlbum { + colName :: String, + colIcon :: String, + colBaseIcon :: String, + colUrl :: String, + colArtist :: String, + colAlbumArtistUrl :: String, + colIsExplicit :: Bool, + colIsClean :: Bool, + colLength :: Int, + colAlbumArtistKey :: String, + colTrackKeys :: [String], + colPrice :: String, + colCanStream :: Bool, + colCanSample :: Bool, + colCanTether :: Bool, + colShortUrl :: String, + colEmbedUrl :: String, + colDisplayDate :: String, + colKey :: String, + colReleaseDate :: String, + colDuration :: Int, + colUserKey :: String, + colUserName :: String, + colAlbumKey :: String, + colAlbumUrl :: String, + colCollectionUrl :: String, + colItemTrackKeys :: [String], + colIframeUrl :: Maybe String, + colUserGender :: Maybe Gender, + colIsCompilation :: Maybe Bool, + colLabel :: Maybe String, + colReleaseDateISO :: Maybe String, + colUpcs :: Maybe [String], + colBigIcon :: Maybe String +} deriving (Show) + +instance FromJSON CollectionAlbum where + parseJSON (Object v) = CollectionAlbum <$> v .: "name" + <*> v .: "icon" + <*> v .: "baseIcon" + <*> v .: "url" + <*> v .: "artist" + <*> v .: "artistUrl" + <*> v .: "isExplicit" + <*> v .: "isClean" + <*> v .: "length" + <*> v .: "artistKey" + <*> v .: "trackKeys" + <*> v .: "price" + <*> v .: "canStream" + <*> v .: "canSample" + <*> v .: "canTether" + <*> v .: "shortUrl" + <*> v .: "embedUrl" + <*> v .: "displayDate" + <*> v .: "key" + <*> v .: "releaseDate" + <*> v .: "duration" + <*> v .: "userkey" + <*> v .: "userName" + <*> v .: "albumKey" + <*> v .: "albumUrl" + <*> v .: "collectionUrl" + <*> v .: "itemTrackKeys" + <*> v .:? "iframeUrl" + <*> v .:? "userGender" + <*> v .:? "isCompilation" + <*> v .:? "label" + <*> v .:? "releaseDateISO" + <*> v .:? "upcs" + <*> v .:? "bigIcon" + +data CollectionArtist = CollectionArtist { + colArtistName :: String, + colArtistKey :: String, + colArtistUrl :: String, + colArtistLength :: Int, + colArtistIcon :: String, + colArtistBaseIcon :: String, + colArtistHasRadio :: Bool, + colArtistShortUrl :: String, + colArtistRadioKey :: String, + colArtistTopSongsKey :: [String], + colArtistUserKey :: String, + colArtistUserName :: String, + colArtistArtistKey :: String, + colArtistArtistUrl :: String, + colArtistCollectionUrl :: String, + colCount :: Maybe Int, + colAlbumCount :: Maybe Int +} deriving (Show) + +instance FromJSON CollectionArtist where + parseJSON (Object v) = CollectionArtist <$> v .: "name" + <*> v .: "key" + <*> v .: "url" + <*> v .: "length" + <*> v .: "icon" + <*> v .: "baseIcon" + <*> v .: "hasRadio" + <*> v .: "shortUrl" + <*> v .: "radioKey" + <*> v .: "topSongsKey" + <*> v .: "userKey" + <*> v .: "userName" + <*> v .: "artistKey" + <*> v .: "artistUrl" + <*> v .: "collectionUrl" + <*> v .:? "count" + <*> v .:? "albumCount" + +data LabelStation = LabelStation { + lsCount :: Int, + lsLabelName :: String, + lsName :: String, + lsHasRadio :: Bool, + lsTracks :: [String], + lsLabelUrl :: String, + lsShortUrl :: String, + lsLength :: Int, + lsUrl :: String, + lsKey :: String, + lsRadioKey :: String, + lsReloadOnRepeat :: Bool, + lsTrackKeys :: Maybe [String] +} deriving (Show) + +instance FromJSON LabelStation where + parseJSON (Object v) = LabelStation <$> v .: "count" + <*> v .: "labelName" + <*> v .: "name" + <*> v .: "hasRadio" + <*> v .: "tracks" + <*> v .: "labelUrl" + <*> v .: "shortUrl" + <*> v .: "length" + <*> v .: "url" + <*> v .: "key" + <*> v .: "radioKey" + <*> v .: "reloadOnRepeat" + <*> v .:? "trackKeys" + +data ArtistStation = ArtistStation { + asRadioKey :: String, + asTopSongsKey :: String, + asBaseIcon :: String, + asTracks :: [String], + asArtistUrl :: String, + asKey :: String, + asReloadOnRepeat :: Bool, + asIcon :: String, + asCount :: Int, + asName :: String, + asHasRadio :: Bool, + asUrl :: String, + asArtistName :: String, + asShortUrl :: String, + asLength :: Int, + asAlbumCount :: Maybe Int, + asTrackKeys :: Maybe [String] +} deriving (Show) + +instance FromJSON ArtistStation where + parseJSON (Object v) = ArtistStation <$> v .: "radioKey" + <*> v .: "topSongsKey" + <*> v .: "baseIcon" + <*> v .: "tracks" + <*> v .: "artistUrl" + <*> v .: "key" + <*> v .: "reloadOnRepeat" + <*> v .: "icon" + <*> v .: "count" + <*> v .: "name" + <*> v .: "hasRadio" + <*> v .: "url" + <*> v .: "artistName" + <*> v .: "shortUrl" + <*> v .: "length" + <*> v .:? "albumCount" + <*> v .:? "trackKeys" + +data HeavyRotationStation = HeavyRotationStation { + hrsKey :: String, + hrsLength :: Int, + hrsTracks :: Int, + hrsReloadOnRepeat :: Bool, + hrsCount :: Int, + hrsUser :: String, + hrsBaseIcon :: String, + hrsIcon :: String, + hrsName :: String, + hrsTrackKeys :: Maybe [String] +} deriving (Show) + +instance FromJSON HeavyRotationStation where + parseJSON (Object v) = HeavyRotationStation <$> v .: "key" + <*> v .: "length" + <*> v .: "tracks" + <*> v .: "reloadOnRepeat" + <*> v .: "count" + <*> v .: "user" + <*> v .: "baseIcon" + <*> v .: "icon" + <*> v .: "name" + <*> v .:? "trackKeys" + +data HeavyRotationUserStation = HeavyRotationUserStation { + hrusKey :: String, + hrusLength :: Int, + hrusTracks :: Int, + hrusReloadOnRepeat :: Bool, + hrusCount :: Int, + hrusUser :: String, + hrusBaseIcon :: String, + hrusIcon :: String, + hrusName :: String, + hrusTrackKeys :: Maybe [String] +} deriving (Show) + +instance FromJSON HeavyRotationUserStation where + parseJSON (Object v) = HeavyRotationUserStation <$> v .: "key" + <*> v .: "length" + <*> v .: "tracks" + <*> v .: "reloadOnRepeat" + <*> v .: "count" + <*> v .: "user" + <*> v .: "baseIcon" + <*> v .: "icon" + <*> v .: "name" + <*> v .:? "trackKeys" + +data ArtistTopSongsStation = ArtistTopSongsStation { + atssRadioKey :: String, + atssTopSongsKey :: String, + atssBaseIcon :: String, + atssTracks :: [String], + atssArtistUrl :: String, + atssKey :: String, + atssReloadOnRepeat :: Bool, + atssIcon :: String, + atssCount :: Int, + atssName :: String, + atssHasRadio :: Bool, + atssUrl :: String, + atssArtistName :: String, + atssShortUrl :: String, + atssLength :: Int, + atssAlbumCount :: Maybe Int, + atssTrackKeys :: Maybe [String] +} deriving (Show) + +instance FromJSON ArtistTopSongsStation where + parseJSON (Object v) = ArtistTopSongsStation <$> v .: "radioKey" + <*> v .: "topSongsKey" + <*> v .: "baseIcon" + <*> v .: "tracks" + <*> v .: "artistUrl" + <*> v .: "key" + <*> v .: "reloadOnRepeat" + <*> v .: "icon" + <*> v .: "count" + <*> v .: "name" + <*> v .: "hasRadio" + <*> v .: "url" + <*> v .: "artistName" + <*> v .: "shortUrl" + <*> v .: "length" + <*> v .:? "albumCount" + <*> v .:? "trackKeys" + +data UserCollectionStation = UserCollectionStation { + ucsKey :: String, + ucsLength :: Int, + ucsTracks :: [String], + ucsReloadOnRepeat :: Bool, + ucsCount :: Int, + ucsUser :: String, + ucsBaseIcon :: String, + ucsIcon :: String, + ucsName :: String, + ucsUrl :: String, + ucsTrackKeys :: Maybe [String] +} deriving (Show) + +instance FromJSON UserCollectionStation where + parseJSON (Object v) = UserCollectionStation <$> v .: "key" + <*> v .: "length" + <*> v .: "tracks" + <*> v .: "reloadOnRepeat" + <*> v .: "count" + <*> v .: "user" + <*> v .: "baseIcon" + <*> v .: "icon" + <*> v .: "name" + <*> v .: "url" + <*> v .:? "trackKeys" + +data RdioResponse v = RdioResponse { + rdioStatus :: String, + rdioResult :: v +} deriving (Show) + +instance FromJSON a => FromJSON (RdioResponse a) where + parseJSON (Object v) = RdioResponse <$> v .: "status" + <*> v .: "result" + +data SearchResults v = SearchResults { + results :: [v] +} deriving (Show) + +instance FromJSON a => FromJSON (SearchResults a) where + parseJSON (Object v) = SearchResults <$> v .: "results" + +data PlaylistType = Owned | Collab | Subscribed + +instance Show PlaylistType where + show Owned = "owned" + show Collab = "collab" + show Subscribed = "subscribed" + +data CollaborationMode = NoCollaboration | CollaborationWithAll | CollaborationWithFollowed deriving (Show) + +data Scope = UserScope | FriendScope | AllScope + +instance Show Scope where + show UserScope = "user" + show FriendScope = "friends" + show AllScope = "everyone" + +data Activity = Activity { + activityUser :: User, + updates :: [Update] +} deriving (Show) + +instance FromJSON Activity where + parseJSON (Object v) = Activity <$> v .: "user" + <*> v .: "updates" + +data UpdateType = UTrackAddedToCollection | UTrackAddedToPlaylist | UFriendAdded | UUserJoined | UCommentOnTrack | UCommentOnAlbum | UCommentOnArtist | UCommentOnPlaylist | UTrackAddedViaMatchCollection | UUserSubscribed | UTrackSynced deriving (Show) + +instance FromJSON UpdateType where + parseJSON (Number n) + | n == 0 = return UTrackAddedToCollection + | n == 1 = return UTrackAddedToPlaylist + | n == 3 = return UFriendAdded + | n == 5 = return UUserJoined + | n == 6 = return UCommentOnTrack + | n == 7 = return UCommentOnAlbum + | n == 8 = return UCommentOnArtist + | n == 9 = return UCommentOnPlaylist + | n == 10 = return UTrackAddedViaMatchCollection + | n == 11 = return UUserSubscribed + | n == 12 = return UTrackSynced + +data Update = Update { + owner :: User, + date :: String, + updateType :: UpdateType +} deriving (Show) + +instance FromJSON Update where + parseJSON (Object v) = Update <$> v .: "owner" + <*> v .: "date" + <*> v .: "update_type" + +data Timeframe = ThisWeek | LastWeek | TwoWeeks + +instance Show Timeframe where + show ThisWeek = "thisweek" + show LastWeek = "lastweek" + show TwoWeeks = "twoweeks"