{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Network.IronMQ.Types where

import Data.Aeson.TH
import Data.Aeson.Types (camelTo)
import Data.Text (Text)
import Data.Char (toLower)

data Client = Client {
    token :: Text,
    projectID :: Text,
    server :: Text,
    apiVersion :: Text
} deriving (Show)

data QueueSummary = QueueSummary {
        qsId :: Text,
        qsProjectId :: Text,
        qsName :: Text
} deriving (Show)

$(deriveJSON defaultOptions{fieldLabelModifier = drop 3.camelTo '_', constructorTagModifier = map toLower, omitNothingFields = True} ''QueueSummary)


data Message = Message {
        mId :: Maybe Text,
        mBody :: Text,
        mTimeout :: Maybe Int,
        mReservedCount :: Maybe Int
} deriving (Show)

$(deriveJSON defaultOptions{fieldLabelModifier = drop 2.camelTo '_', constructorTagModifier = map toLower, omitNothingFields = True} ''Message)

{-# LANGUAGE OverloadedStrings #-}
module Network.IronMQ (
    Client(..),
    queue,
    message,
    queues,
    getQueue,
    getMessages',
    getMessages,
    getMessageById,
    postMessages,
    clear,
    deleteQueue,
    deleteMessage,
    peek',
    peek,
    touch,
    release,
    update
) where

import Network.Wreq
import Network.Wreq.Types (Postable)
import Control.Lens
import Data.Aeson (FromJSON, toJSON)
import Data.Map (fromList, Map)
import Data.Text (Text, append, unpack, pack)
import Data.Text.Encoding (encodeUtf8)
import Network.IronMQ.Types
import Network.HTTP.Client (RequestBody(..))


-- * Some type synonyms to help keep track of things

type Endpoint = Text

type Param = (Text, Text)

type QueueName = Text

type ID = Text -- could be a message ID, subscriber ID or whatever

-- * Some functions to make HTTP requests easier

-- | Construct a base URL for HTTP requests from a client
baseurl :: Client -> Text
baseurl client ="https://" `append` server client `append`"/" `append` apiVersion client
                            `append`"/projects/" `append` projectID client
-- | An empty body for POST/PUT requests
emptyBody :: Payload
emptyBody = Raw"application/json" $ RequestBodyLBS""

-- | Make a GET request to an endpoint using connection info from client and
-- query string set to parameters. Return the JSON results
getJSONWithOpts :: FromJSON a => Client -> Endpoint -> [Param] -> IO a
getJSONWithOpts client endpoint parameters = do
    let url = baseurl client `append` endpoint
        getOpts = defaults & header"Content-Type" .~ ["application/json"]
                           & params .~ ("oauth", token client) : parameters
    response <- asJSON =<< getWith getOpts (unpack url)
    return (response ^. responseBody)

-- | Make a GET request to an endpoint using the connection info from client.
-- Return the JSON results.
getJSON ::FromJSON a => Client -> Endpoint -> IO a
getJSON client s = getJSONWithOpts client s []

-- | Make a POST a request to an endpoint using connection info from client
-- and the body provided. Return the JSON response.
postJSONWithBody :: (Postable a, FromJSON b) => Client -> Endpoint -> a -> IO b
postJSONWithBody client endpoint body = do
    let url = baseurl client `append` endpoint
        postOpts = defaults
                & header"Content-Type" .~ ["application/json"]
                & header"Authorization" .~ [encodeUtf8 ("OAuth" `append` token client)]
    response <- asJSON =<< postWith postOpts (unpack url) body
    return (response ^. responseBody)

-- | Make a POST request to an endpoint using the connection into from client
-- and an empty body. Returb the JSON response.
postJSON :: (FromJSON b) => Client -> Endpoint -> IO b
postJSON client endpoint = postJSONWithBody client endpoint emptyBody

deleteJSON :: FromJSON a => Client ->Endpoint -> IO a
deleteJSON client endpoint = do
        let url = baseurl client `append` endpoint
            deleteOpts = defaults
                & header"Content-Type" .~ ["application/json"]
                & header"Authorization" .~ [encodeUtf8 ("OAuth" `append` token client)]
        response <- asJSON =<< deleteWith deleteOpts (unpack url)
        return (response ^. responseBody)


-- | Get a list of queues available to the client
queues :: Client -> IO [QueueSummary]
queues client = getJSON client"/queues"

-- | Get a queue from the client
getQueue :: Client -> QueueName -> IO Queue
getQueue client queueName = getJSON client ("/queues/" `append` queueName)


-- | Get a list of messages on the queue (allowing specification of number of messages and delay)
getMessages' :: Client -> QueueName -> Maybe Int -> Maybe Int -> IO MessageList
getMessages' client queueName max_ timeout = getJSONWithOpts client endpoint params' where
    endpoint ="/queues/" `append` queueName `append`"/messages"
    params' = case (max_, timeout) of
                (Nothing, Nothing)      ->      []
                (Just x, Nothing)       ->      [("n", pack (show x))]
                (Nothing, Just y)       ->      [("wait", pack (show y))]
                (Just x, Just y)        ->      [("n", pack (show x)), ("wait", pack (show y))]

-- | Get a list of messages on a queue
getMessages :: Client -> QueueName -> IO MessageList
getMessages client queueName = getMessages' client queueName Nothing Nothing

-- | Get a message by ID
getMessageById :: Client -> QueueName -> ID -> IO Message
getMessageById client queueName messageID = getJSON client
    ("/queues/" `append` queueName `append`"/messages/" `append` messageID)

-- | Post messages to a queue
postMessages :: Client -> QueueName -> [Message] -> IO IronResponse
postMessages client queueName messages_ = postJSONWithBody client endpoint body where
        endpoint ="/queues/" `append` queueName `append`"/messages"
        body = toJSON MessageList {mlMessages = messages_}

-- | Delete a message from a queue
deleteMessage :: Client -> QueueName -> ID -> IO IronResponse
deleteMessage client queueName messageID = deleteJSON client endpoint where
        endpoint ="/queues/" `append` queueName `append`"/messages/" `append` messageID

{-# LANGUAGE OverloadedStrings #-}

import Criterion.Main

import Network.IronMQ
import Network.IronMQ.Types

main :: IO ()
main = defaultMain [bench"get queue info, post a message, get messages, delete message" $ nfIO (doStuff)]

testClient :: Client
testClient = Client {
    token ="secret token",
    projectID ="secret project id",
    server ="mq-aws-us-east-1.iron.io",
    apiVersion ="1"
}


doStuff :: IO ()
doStuff = do
    _ <- queues testClient
    postMessages testClient"default" [message{mBody ="This is message number"}]
    messageList <- getMessages testClient"default"
    let messageID = mId (head (mlMessages messageList))
    case messageID of
        Just x -> deleteMessage testClient"default" x
    return ()