module Network.Lastfm.Response
(
Secret(..), sign
, Response, lastfm, lastfm', finalize
) where
import Control.Applicative
import Control.Exception (throw)
import Control.Monad
import Data.Monoid
import Data.String (IsString)
import Crypto.Classes (hash')
import Data.Aeson ((.:), Value, decode, parseJSON)
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 qualified Data.Map as M
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 Network.Lastfm.Internal
class Supported (f :: Format) where
type Response f
parse :: R f -> Lazy.ByteString -> C.ResponseHeaders -> Response f
base :: R f
instance Supported JSON where
type Response JSON = Maybe Value
parse _ b hs = do
v <- decode b
case parseMaybe ((.: "error") <=< parseJSON) v of
Just (_ :: Int) ->
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")]
}
instance Supported XML where
type Response XML = Lazy.ByteString
parse _ b _ = b
base = R
{ _host = "https://ws.audioscrobbler.com/2.0/"
, _method = "GET"
, _query = mempty
}
newtype Secret = Secret Text deriving (Show, IsString)
sign :: Secret -> Request f Sign -> Request f Ready
sign (Secret s) = coerce . (<* signature)
where
signature = wrap $ \r@R { _query = q } ->
r { _query = M.insert "api_sig" (signer (foldr M.delete q ["format", "callback"])) q }
signer = T.pack . show . (hash' :: Strict.ByteString -> MD5Digest) .
T.encodeUtf8 . M.foldrWithKey(\k v xs -> k <> v <> xs) s
lastfm :: Supported f => Request f Ready -> IO (Response f)
lastfm = lastfm' . finalize
finalize :: Supported f => Request f Ready -> R f
finalize = ($ base) . unwrap
lastfm' :: Supported f => R f -> IO (Response f)
lastfm' request =
C.withManager $ \m -> C.parseUrl (render request) >>= \url -> do
t <- C.httpLbs (url { C.method = _method request, C.responseTimeout = Just 10000000 }) m
return $ parse request (C.responseBody t) (C.responseHeaders t)