-- | This module exports functions which are used to execute requests and handle
--   the OAuth authentication process.
module Network.Factual.API
  (
    -- * Authentication
    generateToken
    -- * Read functions
  , executeQuery
  , executeMultiQuery
  , get
    -- * Write functions
  , executeWrite
  , post
    -- * Debug functions
  , debugQuery
  , debugWrite
    -- * The hoauth Token type
  , Token(..)
  , urlEncode
  ) where

import Data.Maybe (fromJust)
import Data.List (intersperse)
import Network.OAuth.Consumer
import Network.OAuth.Http.Request (Request(..), Method(..), parseURL, fromList)
import Network.OAuth.Http.Response (Response(..))
import Network.OAuth.Http.CurlHttpClient (CurlClient(..))
import Data.Aeson (Value, decode)
import Data.Aeson.Encode (encode)
import Data.List.Utils (join)
import Data.Factual.Query
import qualified Data.Factual.Write as W
import qualified Data.Map as M
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Factual.Response as F
import qualified Codec.Binary.Url as U
import qualified Codec.Binary.UTF8.String as S

-- | Key and Secret are both Strings used to create a Token
type Key    = String
type Secret = String
-- | Path, Params and Body are types passed to the get and post functions
type Path   = String
type Params = M.Map String String
type Body   = M.Map String String

-- | This function takes a Key and Secret, and generates a Token that is passed
--   to the various methods used to make requests.
generateToken :: Key -> Secret -> Token
generateToken key secret = fromApplication $ Application key secret OOB

-- | This function takes a Token and Query value and sends the query to the
--   Factual API. The resultant IO action contains a Response value which wraps
--   the resultant data.
executeQuery :: (Query query) => Token -> query -> IO F.Response
executeQuery token query = get token (path query) (params query)

-- | This function can be used to make a Multi Query (multiple queries in a single
--   request. It takes a Token, a Map of key Strings to Queries and returns a Map
--   from the same keys to Response values.
executeMultiQuery :: (Query query) => Token -> M.Map String query -> IO (M.Map String F.Response)
executeMultiQuery token multiMap = do
  let queryString = formMultiQueryString $ M.toList multiMap
  response <- get'' token queryString
  return $ formMultiResponse response $ M.keys multiMap

-- | This function can be used to debug Queries. It takes a Query value and prints
--   out the URL path generated by that query.
debugQuery :: (Query query) => query -> IO ()
debugQuery query = putStrLn $ "Query path: " ++ basePath ++ (formQueryString (path query) (params query))

-- | This function is used to execute Writes. The function takes a Token and a
--   Write value, and returns a Response value.
executeWrite :: (W.Write write) => Token -> write -> IO F.Response
executeWrite token write = post token (W.path write) (W.params write) (W.body write)

-- | This function can be used to debug Writes. It takes a Write value and prints
--   out the URL path, and post body generated by that write.
debugWrite :: (W.Write write) => write -> IO ()
debugWrite write = do
  putStrLn ("Write path: " ++ basePath ++ W.path write)
  putStrLn "Write body:"
  putStrLn $ formParamsString $ W.body write

-- | This function can be used to perform raw read queries to any API endpoint.
--   It takes a Token, a Path string and a Map of params (both keys and values
--   are strings). The function returns a standard Response value.
get :: Token -> Path -> Params -> IO F.Response
get token path params = get' token (formQueryString path params)

-- | This function can be used to perform raw post queries to any API endpoint.
--   It takes a Token, a Path string, a Map of params and a body Map. Both Maps
--   have String keys and values. The function returns a standard Response value.
post :: Token -> Path -> Params -> Body -> IO F.Response
post token path params body = post' token queryString bodyString
  where queryString = formQueryString path params
        bodyString  = formParamsString body

-- The following helper functions aid the exported API functions
get' :: Token -> String -> IO F.Response
get' token queryString = do
  response <- get'' token queryString
  return $ F.fromValue $ extractJSON response

get'' :: Token -> String -> IO Response
get'' token queryString = do
  let fullPath = basePath ++ queryString
  let request = generateRequest fullPath
  execute token request

post' :: Token -> String -> String -> IO F.Response
post' token queryString bodyString = do
  let fullPath = basePath ++ queryString
  let request = generatePostRequest fullPath bodyString
  response <- execute token request
  return $ F.fromValue $ extractJSON response

execute :: Token -> Request -> IO Response
execute token request = runOAuthM token $ setupOAuth request

formQueryString :: String -> M.Map String String -> String
formQueryString path params = path ++ "?" ++ (formParamsString params)

formParamsString :: M.Map String String -> String
formParamsString params = formParamsString' $ M.toList params

formParamsString' :: [(String, String)] -> String
formParamsString' paramList = join "&" $ map formParamParts filteredParams
  where filteredParams = filter (\(k,v) -> "" /= v) paramList

formParamParts :: (String, String) -> String
formParamParts (key, value) = key ++ "=" ++ (urlEncode value)

formMultiQueryString :: (Query query) => [(String, query)] -> String
formMultiQueryString ps = "/multi?queries=" ++ (urlEncode $ "{" ++ (join "," $ map queryPair ps) ++ "}")
  where queryPair (n,q) = "\"" ++ n ++ "\":\"" ++ (formQueryString (path q) (params q)) ++ "\""

formMultiResponse :: Response -> [String] -> M.Map String F.Response
formMultiResponse res ks = M.fromList $ map formPair ks
  where formPair k = (k, F.fromValue $ F.lookupValue k json)
        json       = extractJSON res

generateRequest :: String -> Request
generateRequest url = (fromJust $ parseURL url) { reqHeaders = (fromList headersList) }

generatePostRequest :: String -> String -> Request
generatePostRequest url body = baseRequest { reqHeaders = (fromList postHeaders)
                                           , method = POST
                                           , reqPayload = B.pack body }
  where baseRequest = (fromJust $ parseURL url)
        postHeaders = headersList ++ [("Content-Type", "application/x-www-form-urlencoded")]

setupOAuth :: Request -> OAuthMonadT IO Response
setupOAuth request = do
  oauthRequest <- signRq2 HMACSHA1 Nothing request
  serviceRequest CurlClient oauthRequest

extractJSON :: Response -> Value
extractJSON = fromJust . decode . rspPayload

urlEncode :: String -> String
urlEncode = U.encode . S.encode

headersList :: [(String, String)]
headersList = [("X-Factual-Lib", "factual-haskell-driver-0.5.2")]

basePath :: String
basePath = "http://api.v3.factual.com"