scrobble 0.1.0.1 → 0.2.1.0

raw patch · 5 files changed

+264/−10 lines, 5 filesdep +MissingHdep +containersdep +curlPVP ok

version bump matches the API change (PVP)

Dependencies added: MissingH, containers, curl, pureMD5

API changes (from Hackage documentation)

Files

• scrobble.cabal +11/−5
• src/Scrobble.hs +3/−1
• src/Scrobble/Client.hs +213/−0
• src/Scrobble/Server.hs +2/−1
• src/Scrobble/Types.hs +35/−3

@@ -1,5 +1,5 @@ name:                scrobble-version:             0.1.0.1+version:             0.2.1.0 synopsis:            Scrobbling server. description:         A library providing server-side support                      for the Audioscrobbler Realtime Submission protocol:@@ -19,13 +19,16 @@  library   hs-source-dirs:    src-  exposed-modules:   Scrobble.Server-  other-modules:     Scrobble.Types+  exposed-modules:   Scrobble.Server, Scrobble.Client, Scrobble.Types   build-depends:     base >4 && <5,                      network,                      url,                      time,-                     old-locale+                     old-locale,+                     pureMD5,+                     MissingH,+                     curl,+                     containers  executable scrobble-server   hs-source-dirs:    src@@ -35,4 +38,7 @@                      network,                      url,                      time,-                     old-locale+                     old-locale,+                     MissingH,+                     curl,+                     containers

@@ -2,8 +2,10 @@  module Scrobble   (module Scrobble.Types-  ,module Scrobble.Server)+  ,module Scrobble.Server+  ,module Scrobble.Client)   where  import           Scrobble.Server+import           Scrobble.Client import           Scrobble.Types

@@ -0,0 +1,213 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RecordWildCards #-}++-- | A client for scrobbling, based upon the Audioscrobbler Realtime+-- Submission protocol v1.2+-- <http://www.audioscrobbler.net/development/protocol/>+--+-- Example:+--+-- @+-- import Scrobble.Client+-- import Data.Time+--+-- example = do+--   client <- newClient Details+--     { detPassword = \"YOURPASS\"+--     , detUsername = \"YOURUSER\"+--     , detClient   = \"qlb\"+--     , detVersion  = \"0.9.2\"+--     , detServer   = defaultServer+--     }+--   nowPlaying client NowPlaying+--     { npArtist      = \"Kasabian\"+--     , npTrack       = \"Ladies and Gentlemen\"+--     , npAlbum       = Just \"West Ryder Pauper Lunatic Asylum\"+--     , npLength      = Just 288+--     , npPosition    = Nothing+--     , npMusicBrainz = Nothing+--     }+--   timestamp <- getCurrentTime+--   submitTracks client+--                [Submission { subArtist      = \"Kasabian\"+--                            , subTrack       = \"Ladies and Gentlemen\"+--                            , subTimestamp   = timestamp+--                            , subSource      = UserChosen+--                            , subRating      = Nothing+--                            , subLength      = Just 288+--                            , subAlbum       = Just \"West Ryder Pauper Lunatic Asylum\"+--                            , subPosition    = Nothing+--                            , subMusicBrainz = Nothing+--                            }]+-- @++module Scrobble.Client+  (newClient+  ,nowPlaying+  ,submitTracks+  ,defaultServer+  ,module Scrobble.Types)+  where++import Scrobble.Types++import Control.Arrow+import Control.Exception+import Control.Monad+import Data.Hash.MD5 (Str(..),md5s)+import Data.List+import Data.Maybe+import Data.Time+import Data.Time.Clock.POSIX+import Network.Curl+import Network.URI+import System.Locale++-- | Get a session token.+--+-- The algorithm for generating this token is as follows:+-- token := md5(md5(password) + timestamp)+--+-- The md5() function takes a string and returns the 32-byte ASCII+-- hexadecimal representation of the MD5 hash, using lower case+-- characters for the hex values.+getToken :: String    -- ^ The password.+         -> IO (String,String) -- ^ A session token and timestamp.+getToken password = do+  timestamp <- getCurrentTime+  let et = epoch timestamp+  return (md5 (md5 password ++ et),et)++    where md5 = md5s . Str++-- | Create a client session. Throws "ScrobblerError".+newClient :: Details -> IO Client+newClient Details{..} = withCurlDo $ do+  (token,timestamp) <- getToken detPassword+  let params = [("hs","true")+               ,("p","1.2")+               ,("c",detClient)+               ,("v",detVersion)+               ,("u",detUsername)+               ,("t",timestamp)+               ,("a",token)]+  response <- curlGrab (setQuery detServer params)+           [CurlHttpHeaders [ "Host: " ++ host+                            | Just host <- [fmap uriRegName (uriAuthority detServer)] ]]+  parseAuth response++-- | Parse the auth response.+parseAuth :: CurlGrab -> IO Client+parseAuth CurlGrab{..} =+  case lines grabBody of+    ["OK",token,parseURI -> Just nowplaying,parseURI -> Just submit] ->+      return (Client token nowplaying submit)+    ["BANNED"] -> throw ScrobblerBanned+    ["BADAUTH"] -> throw ScrobblerBadAuth+    ["BADTIME"] -> throw ScrobblerBadTime+    [other] | isPrefixOf failed other ->+              throw (ScrobblerFailed (drop (length failed) other))+            | otherwise -> throw ScrobblerHardFail+  where failed = "FAILED "++-- | Default Audioscrobbler server: http://post.audioscrobbler.com/+defaultServer :: URI+defaultServer = fromJust (parseURI "http://post.audioscrobbler.com/")++-- | Send a now playing message.  Throws "ScrobblerError".+nowPlaying :: Client -> NowPlaying -> IO ()+nowPlaying client@Client{..} nowplaying = do+  CurlGrab{grabBody} <- curlGrab cliNowPlaying+                                 [CurlPost True+                                 ,CurlPostFields (map keyval (makeNowPlaying client nowplaying))]+  unless (trim grabBody == "OK") $+    throw (ScrobblerNowPlayingFail grabBody)++-- | Make a now playing query.+makeNowPlaying :: Client -> NowPlaying -> [(String,String)]+makeNowPlaying Client{..} NowPlaying{..} =+  [("s",cliToken)+  ,("a",npArtist)+  ,("t",npTrack)+  ,("b",fromMaybe "" npAlbum)+  ,("l",maybe "" show npLength)+  ,("n",maybe "" show npPosition)+  ,("m",fromMaybe "" npMusicBrainz)]++-- | Submit track(s).  Throws "ScrobblerError".+submitTracks :: Client -> [Submission] -> IO ()+submitTracks client@Client{..} submissions = do+  CurlGrab{grabBody} <- curlGrab cliSubmit+                                 [CurlPost True+                                 ,CurlPostFields (map keyval params)]+  unless (trim grabBody == "OK") $+    throw (ScrobblerSubmitFail grabBody)++  where params = [("s",cliToken)] +++                 concat (zipWith (makeSubmission client) [0..] submissions)++-- | Make a now playing query.+makeSubmission :: Client -> Integer -> Submission -> [(String,String)]+makeSubmission Client{..} i Submission{..} = map hookup+  [("a",subArtist)+  ,("t",subTrack)+  ,("i",epoch subTimestamp)+  ,("o",fromMaybe "U" (lookup subSource sources))+  ,("r",fromMaybe "" (subRating >>= \r -> lookup r ratings))+  ,("l",maybe "" show subLength)+  ,("b",fromMaybe "" subAlbum)+  ,("n",maybe "" show subPosition)+  ,("m",fromMaybe "" subMusicBrainz)]++  where sources = [(UserChosen,"P")+                  ,(NonPersonlizedBroadcast,"R")+                  ,(Personalized,"E")+                  ,(LastFm,"L")]+        ratings = [(Love,"L"),(Ban,"B"),(Skip,"S")]+        hookup (k,v) = (k ++ "[" ++ show i ++ "]",v)++--------------------------------------------------------------------------------+-- Utilities++-- | Encode post parameters to a string.+encodePost :: [(String,String)] -> String+encodePost = intercalate "&" . map (keyval . (encode *** encode)) where+  encode = escapeURIString isUnescapedInURI++-- | Make a key=val string.+keyval :: (String,String) -> String+keyval (key,val) = key ++ "=" ++ val++-- | Set a URI's query.+setQuery :: URI -> [(String,String)] -> URI+setQuery uri assoc = uri { uriQuery = "?" ++ encodePost assoc }++-- | Format a time to UNIX number.+epoch :: UTCTime -> String+epoch = formatTime defaultTimeLocale "%s"++-- | Just strip whitespace.+trim :: String -> String+trim = unwords . words++--------------------------------------------------------------------------------+-- Make Curl's API not crappy.++-- | Grab a URL with curl.+curlGrab :: URI -> [CurlOption] -> IO CurlGrab+curlGrab url options = do+  CurlResponse{..} <- curlGetResponse_ (show url) options+  return $ CurlGrab respCurlCode respStatus respStatusLine respHeaders respBody++-- | A sane data type.+data CurlGrab = CurlGrab+  { grabCode       :: CurlCode+  , grabStatus     :: Int+  , grabStatusLine :: String+  , grabHeaders    :: [(String,String)]+  , grabBody       :: String+  } deriving (Show)

@@ -6,7 +6,8 @@ -- <http://www.audioscrobbler.net/development/protocol/>  module Scrobble.Server-  (startScrobbleServer)+  (startScrobbleServer+  ,module Scrobble.Types)   where  import           Scrobble.Types

@@ -1,9 +1,14 @@+{-# LANGUAGE DeriveDataTypeable #-}+ -- | Scrobbling data types.  module Scrobble.Types where -import           Data.Time-import           Network+import Control.Exception+import Data.Data+import Data.Time+import Network+import Network.URI (URI)  -- | Server configuration. data Config = Config@@ -93,7 +98,34 @@    deriving (Show,Enum,Eq,Read) - -- | Server response. data Response = OK | BANNED | BADAUTH | FAILED String | BADSESSION   deriving Show++-- | A scrobbling client.+data Client = Client+  { cliToken      :: String -- ^ Session token.+  , cliNowPlaying :: URI    -- ^ Now playing URL to submit to.+  , cliSubmit     :: URI    -- ^ URL to submit listened tracks to.+  } deriving (Show)++-- | Details for creating a scrobbling client.+data Details = Details+  { detPassword :: String+  , detUsername :: String+  , detClient :: String -- ^ E.g. “qlb”.+  , detVersion :: String -- ^ E.g. “0.9.2”.+  , detServer :: URI -- ^ See defaultServer in "Scrobble.Client".+  } deriving (Show)++-- | Scrobble exception.+data ScrobblerError+  = ScrobblerBanned+  | ScrobblerBadAuth+  | ScrobblerBadTime+  | ScrobblerFailed String+  | ScrobblerHardFail+  | ScrobblerSubmitFail String+  | ScrobblerNowPlayingFail String+  deriving (Show,Typeable,Data)+instance Exception ScrobblerError