module Web.Last.Request where

import Web.Last.Types
import Network.Curl
import Data.Digest.OpenSSL.MD5
import Web.Last.Parsing
import Text.JSON.Combinators
import Text.JSON.String
import Text.JSON
import Control.Monad.State
import Control.Monad.Error
import Data.Partial
import Data.ByteString.Char8 (pack)
import Data.List (sort)
import System.IO.Unsafe

{-
  This module needs to expose functions for handling
  both authorization requiring & non-authorization
  requiring API calls.  I want functions to be exposed
  that will allow you to build up external API functions
  with almost no effort.
-}

root :: String
root = "http://ws.audioscrobbler.com/2.0/"

type Method = String
type Params = [(String,String)]
type OptParams = [(String,Maybe String)]

signature :: Method -> Params -> Last String
signature m ps = do
  (LastState k s _) <- get
  return $ md5sum . pack $ signature' m ps k s

signature' :: Method -> Params -> APIKey -> Secret -> String
signature' m ps k s = str ++ s
 where str = concat . map (uncurry (++)) . sort $
               ("api_key",k):("method",m):ps

getToken :: Last Token
getToken = do
  t <- gets tok
  case t of
    Just t' -> return t'
    Nothing -> do
      s <- signature "auth.GetToken" []
      t <- anonRequest "auth.GetToken" [("api_sig",s)] [] token
      modify (\ls -> ls{tok=Just t})
      return t

paramsToStr :: Params -> String
paramsToStr p = concat ["&" ++ k ++ "=" ++ v | (k,v) <- p]

optParamsToStr :: OptParams -> String
optParamsToStr op = concat ["&" ++ k ++ "=" ++ v | (k,Just v) <- op]

url m k p op = root++"?method="++m
               ++(paramsToStr p)++(optParamsToStr op)
               ++"&api_key="++k++"&format=json"

raiseEither (Left e) = throwError e
raiseEither (Right v) = return v

errorOrValue :: JSValTo a -> JSValTo a
errorOrValue f = Partial $
  \js -> case lastFMError `apply` js of
          Left e -> f `apply` js
          Right v -> Left ("LastFM api error "++ show (errorNo v) ++": "++message v)

fetchJSON :: String -> IO (Either String JSValue)
fetchJSON targetUrl = do
    (_,s) <- curlGetString targetUrl [] -- Should test for curl errors here?
    return $ case (runGetJSON readJSValue s) of
        Left e -> Left (e ++ "\n\nReading json string:\n\n" ++ s ++ "\n\nFrom url: " ++ targetUrl)
        Right js -> Right js

anonRequest :: Method -> Params -> OptParams -> JSValTo a -> Last a
anonRequest m p op marshal = do
  (LastState k _ _) <- get
  js <- liftIO $ fetchJSON (url m k p op)
  raiseEither $ apply (errorOrValue marshal) =<< js

authRequest :: Method -> Params -> JSValTo a -> Last a
authRequest = undefined

pagedRequest :: Method -> Params -> OptParams -> JSValTo [a] -> JSValTo Int -> Last (Paged a)
pagedRequest m p op marshalPage marshalNo = do
    noPages <- anonRequest m (("page","0"):p) op marshalNo
    return $ Paged $ map page [1..noPages]
    where page i = anonRequest m (("page",show i):p) op marshalPage