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(..))
type Url = Text
type Endpoint = Text
type Param = (Text, Text)
type QueueName = Text
type ID = Text
baseurl :: Client -> Text
baseurl client = "https://" `append` server client `append` "/" `append` apiVersion client
`append` "/projects/" `append` projectID client
emptyBody :: Payload
emptyBody = Raw "application/json" $ RequestBodyLBS ""
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)
getJSON ::FromJSON a => Client -> Endpoint -> IO a
getJSON client s = getJSONWithOpts client s []
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)
postJSON :: (ToJSON b, 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)
queues :: Client -> IO [QueueSummary]
queues client = getJSON client "/queues"
getQueue :: Client -> QueueName -> IO Queue
getQueue client queueName = getJSON client ("/queues/" `append` queueName)
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))]
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)
getMessagePushStatus :: Client -> QueueName -> ID -> IO PushStatus
getMessagePushStatus client queueName messageID = undefined
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 :: Client -> QueueName -> IO IronResponse
clear client queueName = postJSON client ("/queues/" `append` queueName `append` "/clear")
deleteQueue :: Client -> QueueName -> IO IronResponse
deleteQueue client queueName = deleteJSON client endpoint where
endpoint = "/queues/" `append` queueName
deleteMessage :: Client -> QueueName -> ID -> IO IronResponse
deleteMessage client queueName messageID = deleteJSON client endpoint where
endpoint = "/queues/" `append` queueName `append` "/messages/" `append` messageID
deleteMessagePushStatus :: Client -> QueueName -> ID -> IO IronResponse
deleteMessagePushStatus client queueName messageID = undefined
deleteAlerts :: Client -> QueueName -> [ID] -> IO IronResponse
deleteAlerts client queueName alertIDs = undefined
deleteAlert :: Client -> QueueName -> ID -> IO IronResponse
deleteAlert client queueName alertID = undefined
deleteSubscribers client queueName subscribers = undefined
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 :: 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 :: Client -> QueueName -> [Subscriber] -> IO IronResponse
update client queueName subscribers = undefined
addAlerts :: Client -> QueueName -> [Alert] -> IO IronResponse
addAlerts client queueName alerts = undefined
updateAlerts :: Client -> QueueName -> [Alert] -> IO IronResponse
updateAlerts client queueName alerts = undefined
addSubscribers :: Client -> QueueName -> [Subscriber] -> IO IronResponse
addSubscribers client queueName subscribers = undefined