-- | 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
    -- * Options type
  , Options(..)
  , Long
    -- * 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 Network.Curl.Opts (CurlOption(..))
import Data.Aeson (Value, decode)
import Data.Aeson.Encode (encode)
import Data.List.Utils (join)
import Data.Factual.Query
import Network.Curl.Types (Long)
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

-- | Options is used to store the Token and a potential timeout
data Options = Options { token   :: Token,
                         timeout :: Maybe Long }

-- | 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 Options and a 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) => Options -> query -> IO F.Response
executeQuery options query = get options (path query) (params query)

-- | This function can be used to make a Multi Query (multiple queries in a single
--   request. It takes Options, a Map of key Strings to Queries and returns a Map
--   from the same keys to Response values.
executeMultiQuery :: (Query query) => Options -> M.Map String query -> IO (M.Map String F.Response)
executeMultiQuery options multiMap = do
  let queryString = formMultiQueryString $ M.toList multiMap
  response <- get'' options 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 Options and a
--   Write value, and returns a Response value.
executeWrite :: (W.Write write) => Options -> write -> IO F.Response
executeWrite options write = post options (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 Options, a Path string and a Map of params (both keys and values
--   are strings). The function returns a standard Response value.
get :: Options -> Path -> Params -> IO F.Response
get options path params = get' options (formQueryString path params)

-- | This function can be used to perform raw post queries to any API endpoint.
--   It takes Options, 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 :: Options -> Path -> Params -> Body -> IO F.Response
post options path params body = post' options queryString bodyString
  where queryString = formQueryString path params
        bodyString  = formParamsString body

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

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

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

execute :: Options -> Request -> IO Response
execute options request = runOAuthM auth $ setupOAuth request to
  where auth = token options
        to = timeout options

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 -> Maybe Long -> OAuthMonadT IO Response
setupOAuth request Nothing = do
  oauthRequest <- signRq2 HMACSHA1 Nothing request
  serviceRequest CurlClient oauthRequest
setupOAuth request (Just timeout) = do
  oauthRequest <- signRq2 HMACSHA1 Nothing request
  serviceRequest (OptionsCurlClient [CurlTimeout timeout]) 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.6.1")]

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