IronMQ.hs

{-# LANGUAGE OverloadedStrings #-}
module Network.IronMQ (module Network.IronMQ, Network.IronMQ.Types.Client(..)) 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 "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


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

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 messageList = undefined

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

-- | Delete a message from a queue
deleteMessage :: Client -> QueueName -> ID -> IO IronResponse
deleteMessage client queueName messageID = undefined

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

-- | 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 -> IO IronResponse
peek client queueName = undefined

-- | Touch a message on the queue
touch :: Client -> QueueName -> ID -> IO IronResponse
touch client queueName messageID = undefined

-- | Update a
update client queueName subscribers = undefined

-- | Add alerts to a queue
addAlerts client queueName alerts = undefined

-- | Update alerts on a queue
updateAlerts client queueName alerts = undefined

-- | Add subscribers to a queue
addSubsrubers client queueName subscribers = undefined
-}