IronMQ.hs

{-# LANGUAGE OverloadedStrings #-}
module Network.IronMQ (module
        Network.IronMQ, 
        Client(..),
        message
        ) where

import Network.Wreq
import Network.Wreq.Types (Postable)
import Control.Lens
import Data.Aeson (FromJSON, ToJSON, toJSON)
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 keel track of things

type Url = Text

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 :: (ToJSON b, FromJSON b) => Client -> Endpoint -> IO b
postJSON client endpoint = postJSONWithBody client endpoint emptyBody

{-
deleteJSONWithBody :: (Postable a, FromJSON b) => Client ->Endpoint -> Postable a -> IO b
deleteJSONWithBody client endpoint body = 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)
-}

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)

-- * The public API

-- | 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)

-- | Get the push status of a message
getMessagePushStatus :: Client -> QueueName -> ID -> IO PushStatus
getMessagePushStatus client queueName messageID = undefined

-- | 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 {messages = messages})


-- | Clear all messages from a queue
clear :: Client -> QueueName -> IO IronResponse
clear client queueName = postJSON client ("/queues/" `append` queueName  `append` "/clear")

-- | Delete a queue
deleteQueue :: Client -> QueueName -> IO IronResponse
deleteQueue client queueName = deleteJSON client endpoint where
        endpoint = "/queues/" `append` queueName

-- | 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

{-
-- | Delete several messages from a queue
deleteMessages :: Client -> QueueName -> [ID] -> IO IronResponse
deleteMessages client queueName meessageIDs = deleteJSON client endpoint
-}

-- | Delete the message push status of a message
deleteMessagePushStatus :: Client -> QueueName -> ID -> IO IronResponse
deleteMessagePushStatus client queueName messageID = undefined

-- | Remove alerts from a queue
deleteAlerts :: Client -> QueueName -> [ID] -> IO IronResponse
deleteAlerts client queueName alertIDs = undefined

-- | Remove an alert from a queue
deleteAlert :: Client -> QueueName -> ID -> IO IronResponse
deleteAlert client queueName alertID = undefined

-- Remove subscribers from a queue
deleteSubscribers client queueName subscribers = undefined

-- | Take a look at the next item on the queue
peek' :: Client -> QueueName -> Maybe Int -> IO MessageList
peek' client queueName max = getJSONWithOpts client endpoint opts where
        opts = case max of
                Nothing -> []
                Just x -> [("n", pack (show x))]
        endpoint = "/queues/" `append` queueName `append` "/messages/peek"

peek :: Client -> QueueName -> IO MessageList
peek client queueName = peek' client queueName Nothing

-- | Touch a message on the queue
touch :: Client -> QueueName -> ID -> IO IronResponse
touch client queueName messageID = postJSON client endpoint where
        endpoint = "/queues/" `append` queueName `append` "/messages/" `append` pack (show messageID) `append` "/touch"

-- | Update a queues subscribers
update :: Client -> QueueName -> [Subscriber] -> IO IronResponse
update client queueName subscribers = undefined

-- | Add alerts to a queue
addAlerts :: Client -> QueueName -> [Alert] -> IO IronResponse
addAlerts client queueName alerts = undefined

-- | Update alerts on a queue
updateAlerts :: Client -> QueueName -> [Alert] -> IO IronResponse
updateAlerts client queueName alerts = undefined

-- | Add subscribers to a queue
addSubscribers :: Client -> QueueName -> [Subscriber] -> IO IronResponse
addSubscribers client queueName subscribers = undefined