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
getToken :: String
-> IO (String,String)
getToken password = do
timestamp <- getCurrentTime
let et = epoch timestamp
return (md5 (md5 password ++ et),et)
where md5 = md5s . Str
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
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 "
defaultServer :: URI
defaultServer = fromJust (parseURI "http://post.audioscrobbler.com/")
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)
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)]
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)
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)
encodePost :: [(String,String)] -> String
encodePost = intercalate "&" . map (keyval . (encode *** encode)) where
encode = escapeURIString isUnescapedInURI
keyval :: (String,String) -> String
keyval (key,val) = key ++ "=" ++ val
setQuery :: URI -> [(String,String)] -> URI
setQuery uri assoc = uri { uriQuery = "?" ++ encodePost assoc }
epoch :: UTCTime -> String
epoch = formatTime defaultTimeLocale "%s"
trim :: String -> String
trim = unwords . words
curlGrab :: URI -> [CurlOption] -> IO CurlGrab
curlGrab url options = do
CurlResponse{..} <- curlGetResponse_ (show url) options
return $ CurlGrab respCurlCode respStatus respStatusLine respHeaders respBody
data CurlGrab = CurlGrab
{ grabCode :: CurlCode
, grabStatus :: Int
, grabStatusLine :: String
, grabHeaders :: [(String,String)]
, grabBody :: String
} deriving (Show)