diff --git a/Network/MicrosoftAzure/ServiceBus.hs b/Network/MicrosoftAzure/ServiceBus.hs new file mode 100644 --- /dev/null +++ b/Network/MicrosoftAzure/ServiceBus.hs @@ -0,0 +1,26 @@ +-- | +-- Module : Network.MicrosoftAzure.ServiceBus +-- Description : Haskell Types for interacting with ServiceBus +-- Copyright : (c) Hemanth Kapila, 2014 +-- License : BSD3 +-- Maintainer : saihemanth@gmail.com +-- Stability : Experimental +-- +-- Haskell API for working with +module Network.MicrosoftAzure.ServiceBus ( + -- * Servicebus Types + SBInfo (..), + -- | Abstract type representing the service bus context. + SBContext, + -- Broker Properties + BrokerProperties (..), + -- * Initialization + simpleSBInfo, + sbContext, + -- * Locked Messages + unlockMessage, + renewLock, + deleteMessage + ) where + +import Network.MicrosoftAzure.ServiceBus.SBTypes diff --git a/Network/MicrosoftAzure/ServiceBus/Queue.hs b/Network/MicrosoftAzure/ServiceBus/Queue.hs new file mode 100644 --- /dev/null +++ b/Network/MicrosoftAzure/ServiceBus/Queue.hs @@ -0,0 +1,155 @@ +-- | +-- Module : Network.MicrosoftAzure.ServiceBus.Queue +-- Description : API for reading from and writing to ServiceBus Queue +-- Copyright : (c) Hemanth Kapila, 2014 +-- License : BSD3 +-- Maintainer : saihemanth@gmail.com +-- Stability : Experimental +-- +-- Provides API to pull from and push to ServiceBus queue +-- Please refer to for information on the API provided by +-- Microsoft Service bus. +-- +-- Simple example for how to use this library is as below +-- +-- @ +-- import Network.MicrosoftAzure.ServiceBus.Queue +-- import Network.MicrosoftAzure.ServiceBus +-- import qualified Data.ByteString.Char8 as C +-- +-- queueName = "queueName" +-- sbNamespace = "namespace" +-- sbIssuerKey = C.pack "1287361251262as=" +-- sbIssuerName = C.pack "owner" +-- +-- sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey +-- message = C.pack "Hello from Haskell" +-- +-- main = do +-- sbContext <- sbContext sbinfo +-- enQueueBS queueName message sbContext +-- res <- deQueue queueName 30 sbContext +-- print res +-- @ +-- +-- see examples (available as a part of distribution) for a more detailed example. + +module Network.MicrosoftAzure.ServiceBus.Queue( + -- Locked Message Info + QLockedMsgInfo, + -- * Pushing data to Queue + enQueueBS, + enQueueLBS, + enQueueBodySrc, + -- * Reading data from Queue + deQueue, + peekLockQueue + )where + +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import Data.Conduit +import Data.Int + +import Network.MicrosoftAzure.ACS +import Network.MicrosoftAzure.ServiceBus.SBTypes +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import Network.HTTP.Conduit hiding (requestBodySource) +import Network.HTTP.Client.Conduit hiding (httpLbs) +import Network.HTTP.Types.Method (methodDelete, methodPost,methodPut) +import Network.HTTP.Types.Header +import Network.HTTP.Types.Method + +import qualified Data.CaseInsensitive as CI +import Network.Connection (TLSSettings (..)) +import Network(withSocketsDo) + + +-- | 'QLockedMsgInfo' provides Information of the locked message from a queue. +-- +data QLockedMsgInfo = QLockedMsgInfo String BrokerProperties + deriving (Show) + +-- | Internal low-level method for performing HTTP calls. +-- +-- Not exposed to the user +enQueueRequest :: String -> RequestBody -> SBContext -> IO () +enQueueRequest queueName body (SBContext baseUrl manager aContext) = do + token <- acsToken manager aContext + reqInit <- parseUrl (baseUrl ++ "/" ++ queueName ++ "/messages") + withSocketsDo $ httpLbs (reqInit { method = methodPost, + requestHeaders = [token], + requestBody = body + }) manager + return () + +-- | Internal low-level method for creating the HTTP calls. For internal use. +-- +-- should be avoided by most users +deQueueRequest :: String -> Int -> SBContext -> IO L.ByteString +deQueueRequest queueName timeout (SBContext baseUrl manager aContext) = do + token <- acsToken manager aContext + reqInit <- parseUrl (baseUrl ++ "/" ++ queueName ++ "/messages/head?timeout=" ++ (show timeout)) + res <-withSocketsDo $ httpLbs ( reqInit { method = methodDelete, + requestHeaders = [token] + }) manager + return $ responseBody res + +-- | publish a message containing 'C.ByteString' to queue. +-- +-- The following publishes a strict bytestring \bs\ to queue \q\ +-- +-- @ +-- enQueueBS q bs ctx +-- @ +enQueueBS :: String -> C.ByteString -> SBContext -> IO () +enQueueBS queueName content context = + enQueueRequest queueName (RequestBodyBS content) context + + +-- | publish a message containing 'L.ByteString' to queue +-- +-- The following publishes a lazy bytestring ,\lbs\, to queue \q\, +-- +-- @ +-- enQueueLBS q lbs ctx +-- @ +-- +enQueueLBS :: String -> L.ByteString -> SBContext -> IO () +enQueueLBS queueName content context = + enQueueRequest queueName (RequestBodyLBS content) context + + +-- | publish from a 'Source' (refer to 'requestBodySource') +enQueueBodySrc :: String -> Int64 -> Source IO C.ByteString -> SBContext -> IO () +enQueueBodySrc queueName len bodysrc context = enQueueRequest queueName (requestBodySource len bodysrc) context + + +-- | Reads and deletes the message from a queue. +-- +-- +-- In order to destructively read the latest message from the queue (with a time out of n seconds), +-- +-- +-- @ +-- deQueue queueName n context +-- @ +-- Note that the timeout can be at the most 55 seconds. This silently \ignores\ the timeouts greater than 55 +deQueue :: String -> Int -> SBContext -> IO (L.ByteString) +deQueue queueName timeout context = deQueueRequest queueName (timeout `mod` 55) context + +-- | Peek Lock Message from a Queue. Non-Destructive Read. +-- +-- Atomically retrieves the next message from a queue and locks it for further processing. The message is guaranteed not to be delivered to +-- other receivers (on the same subscription) during the duration of the lock. +-- +-- Refer for semantics of the underlying REST API. +peekLockQueue :: String -> Int -> SBContext -> IO (LockedMsgInfo,L.ByteString) +peekLockQueue qName timeout (SBContext baseUrl manager aContext) = do + token <- acsToken manager aContext + reqInit <- parseUrl (baseUrl ++ "/" ++ qName ++ "/messages/head?timeout=" ++ (show timeout)) + res <-withSocketsDo $ httpLbs (reqInit { method = methodPost, + requestHeaders = [token] + }) manager + return $ (getQLI res,responseBody res) diff --git a/Network/MicrosoftAzure/ServiceBus/SBTypes.hs b/Network/MicrosoftAzure/ServiceBus/SBTypes.hs new file mode 100644 --- /dev/null +++ b/Network/MicrosoftAzure/ServiceBus/SBTypes.hs @@ -0,0 +1,166 @@ +-- | +-- Module : Network.MicrosoftAzure.ServiceBus.SBTypes +-- Description : Haskell Types for interacting with ServiceBus +-- Copyright : (c) Hemanth Kapila, 2014 +-- License : BSD3 +-- Maintainer : saihemanth@gmail.com +-- Stability : Experimental +-- +-- Provides Types used across the rest of the API. +-- +{-# LANGUAGE OverloadedStrings #-} +module Network.MicrosoftAzure.ServiceBus.SBTypes + where + +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import Data.Conduit +import Data.Int + +import Network.MicrosoftAzure.ACS +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import Network.HTTP.Conduit hiding (requestBodySource) +import Network.HTTP.Client.Conduit hiding (httpLbs) +import Network.HTTP.Types.Method (methodDelete, methodPost,methodPut) +import Network.HTTP.Types.Header +import Network(withSocketsDo) + +import Network.Connection (TLSSettings (..)) +import Data.Aeson +import Data.Monoid +import Control.Applicative +import qualified Data.CaseInsensitive as CI + + +-- | 'SBInfo' is encapsulation of Connection Information needed to connect to a Service Bus Namespace. +-- +-- This information is typically found when you click on the /Connection Information/ link on the azure portal and comprises of +-- +-- * ServiceBus namespace +-- +-- * Issuer Name +-- +-- * Issuer Key +-- +-- +data SBInfo = SBInfo String C.ByteString C.ByteString + deriving (Show) + +-- | Abstract type representing the service bus context. +data SBContext = SBContext String Manager AcsContext + +-- | a convenience function, where issuer name is owner +simpleSBInfo :: String -> String -> SBInfo +simpleSBInfo ns key = SBInfo ns (C.pack "owner") (C.pack key) + +-- | Create SB Context from 'SBInfo' +sbContext :: SBInfo -> IO SBContext +sbContext (SBInfo ns name key) = do + aContext <- acsContext $ AcsInfo (ns ++ "-sb") (C.pack $ "http://" ++ ns ++ ".servicebus.windows.net") name key + manager <- newManagerSettings (mkManagerSettings (TLSSettingsSimple True False False) Nothing) + return $ SBContext ("https://" ++ ns ++ ".servicebus.windows.net") manager aContext + +-- | BrokerProperties +data BrokerProperties = BrokerProperties { + deliveryCount :: Int, + enqueuedSeqNumber :: Integer, + enqueuedTimeUtc :: String, + lockToken :: String, + lockedUntilUtc :: String, + bpMessageId :: String, + bpSequenceNumber :: Integer, + bpState :: String, + bpTimeToLive :: Integer +} + deriving (Show) + +instance FromJSON BrokerProperties where + parseJSON (Object v) = BrokerProperties <$> + v .: "DeliveryCount" <*> + v .: "EnqueuedSequenceNumber" <*> + v .: "EnqueuedTimeUtc" <*> + v .: "LockToken" <*> + v .: "LockedUntilUtc" <*> + v .: "MessageId" <*> + v .: "SequenceNumber" <*> + v .: "State" <*> + v .: "TimeToLive" + parseJSON _ = mempty + +instance ToJSON BrokerProperties where + toJSON (BrokerProperties dc esq etc lt luu msgId sn stt ttl) = object [ + "DeliveryCount" .= dc, + "EnqueuedSequenceNumber" .= esq, + "EnqueuedTimeUtc" .= etc, + "LockToken" .= lt, + "LockedUntilUtc" .= luu, + "MessageId" .= msgId, + "SequenceNumber" .= sn, + "State" .= stt, + "TimeToLive" .= ttl + ] + +emptyBP = BrokerProperties 0 0 "" "" "" "" 0 "" 0 + +-- | 'LockedMsgInfo' provides Information of the locked message. +-- +data LockedMsgInfo = LockedMsgInfo String BrokerProperties + deriving (Show) + + +-- | Unlock a messages that has been locked earlier. +-- +-- see 'Network.MicrosoftAzure.ServiceBus.Topic.peekLockTopic' and 'Network.MicrosoftAzure.ServiceBus.Queue.peekLockQueue'. +-- +-- Also consult and for details on the underlying REST API. +unlockMessage :: LockedMsgInfo -> SBContext -> IO () +unlockMessage (LockedMsgInfo url brokerProps) (SBContext baseUrl manager acsContext) = do + token <- acsToken manager acsContext + reqInit <- parseUrl url + res <-withSocketsDo $ httpLbs (reqInit { method = methodPut, + requestHeaders = [token] + }) manager + return () + +-- | Delete a message that has been locked earlier. +-- +-- see 'Network.MicrosoftAzure.ServiceBus.Topic.peekLockTopic' and 'Network.MicrosoftAzure.ServiceBus.Queue.peekLockQueue'. +-- +-- Also consult and for details on the underlying REST API. +deleteMessage :: LockedMsgInfo -> SBContext -> IO () +deleteMessage (LockedMsgInfo url brokerProps) (SBContext baseUrl manager acsContext) = do + token <- acsToken manager acsContext + reqInit <- parseUrl url + res <-withSocketsDo $ httpLbs (reqInit { method = methodDelete, + requestHeaders = [token] + }) manager + return () + +-- | Renews lock on a locked message +-- +-- see 'Network.MicrosoftAzure.ServiceBus.Topic.peekLockTopic' and 'Network.MicrosoftAzure.ServiceBus.Queue.peekLockQueue'. +-- +-- Also consult and for details on the underlying REST API. +renewLock :: LockedMsgInfo -> SBContext -> IO () +renewLock (LockedMsgInfo url brokerProps) (SBContext baseUrl manager acsContext) = do + token <- acsToken manager acsContext + reqInit <- parseUrl url + res <-withSocketsDo $ httpLbs (reqInit { method = methodPost, + requestHeaders = [token] + }) manager + return () + + + +getQLI :: Response L.ByteString -> LockedMsgInfo +getQLI res = LockedMsgInfo loc bp + where + loc = case lookup hLocation (responseHeaders res) of + Nothing -> error "Expected Location Header in the response!" + Just x -> C.unpack x + bp = case lookup (CI.mk . C.pack $ "BrokerProperties") (responseHeaders res) of + Nothing -> emptyBP + Just bs -> case decode $ L.fromChunks [bs] of + Nothing -> emptyBP + Just b -> b diff --git a/Network/MicrosoftAzure/ServiceBus/Topic.hs b/Network/MicrosoftAzure/ServiceBus/Topic.hs new file mode 100644 --- /dev/null +++ b/Network/MicrosoftAzure/ServiceBus/Topic.hs @@ -0,0 +1,149 @@ +-- | +-- Module : Network.MicrosoftAzure.ServiceBus.Topic +-- Description : API for reading from and writing to ServiceBus Topic +-- Copyright : (c) Hemanth Kapila, 2014 +-- License : BSD3 +-- Maintainer : saihemanth@gmail.com +-- Stability : Experimental +-- +-- Provides API to pull from and push to ServiceBus topic +-- Please refer to for information on the API provided by +-- Microsoft Service bus. +-- +-- Simple example for how to use this library is as below +-- +-- @ +-- import Network.MicrosoftAzure.ServiceBus.Topic +-- import Network.MicrosoftAzure.ServiceBus +-- import qualified Data.ByteString.Char8 as C +-- +-- topicName = "topicName" +-- subscriptionName = "subscriptionName" +-- sbNamespace = "namespace" +-- sbIssuerKey = C.pack "1287361251262as=" +-- sbIssuerName = C.pack "owner" +-- +-- sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey +-- message = C.pack "Hello from Haskell" +-- +-- main = do +-- sbContext <- sbContext sbinfo +-- sendTopicBS topicName message sbContext +-- res <- destructiveRead topicName subscriptionName 30 sbContext +-- print res +-- @ +-- +-- see examples (available as a part of distribution) for a more detailed example. + +module Network.MicrosoftAzure.ServiceBus.Topic( + -- * Pushing data to Topic + sendTopicBS, + sendTopicLBS, + sendTopicBodySrc, + -- * Reading data from Topic + destructiveRead, + peekLockTopic + )where + +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import Data.Conduit +import Data.Int + +import Network.MicrosoftAzure.ACS +import Network.MicrosoftAzure.ServiceBus.SBTypes +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import Network.HTTP.Conduit hiding (requestBodySource) +import Network.HTTP.Client.Conduit hiding (httpLbs) +import Network.HTTP.Types.Method (methodDelete, methodPost,methodPut) +import Network.HTTP.Types.Header +import Network.HTTP.Types.Method + +import qualified Data.CaseInsensitive as CI +import Network.Connection (TLSSettings (..)) +import Data.Aeson +import Network(withSocketsDo) + +-- | Internal low-level method for performing HTTP calls. +-- +-- Not exposed to the user +sendTopicRequest :: String -> RequestBody -> SBContext -> IO () +sendTopicRequest topicName body (SBContext baseUrl manager aContext) = do + token <- acsToken manager aContext + reqInit <- parseUrl (baseUrl ++ "/" ++ topicName ++ "/messages") + withSocketsDo $ httpLbs (reqInit { method = methodPost, + requestHeaders = [token], + requestBody = body + }) manager + return () + +-- | Internal low-level method for creating the HTTP calls. For internal use. +-- +-- Not exposed to the user +destructiveReadRequest :: String -> String -> Int -> SBContext -> IO L.ByteString +destructiveReadRequest topic subsc timeout (SBContext baseUrl manager aContext) = do + token <- acsToken manager aContext + reqInit <- parseUrl (baseUrl ++ "/" ++ topic ++ "/Subscriptions/" ++ subsc ++ "/messages/head?timeout=" ++ (show timeout)) + res <-withSocketsDo $ httpLbs ( reqInit { method = methodDelete, + requestHeaders = [token] + }) manager + return $ responseBody res + +-- | publish a message containing 'C.ByteString' to a topic. +-- +-- The following publishes a strict bytestring \bs\ to topic \t\ +-- +-- @ +-- sendTopicBS t bs ctx +-- @ +sendTopicBS :: String -> C.ByteString -> SBContext -> IO () +sendTopicBS topicName content context = + sendTopicRequest topicName (RequestBodyBS content) context + + +-- | publish a message containing 'L.ByteString' to a topic +-- +-- The following publishes a lazy bytestring ,\lbs\, to topic \t\, +-- +-- @ +-- sendTopicLBS t lbs ctx +-- @ +-- +sendTopicLBS :: String -> L.ByteString -> SBContext -> IO () +sendTopicLBS topicName content context = + sendTopicRequest topicName (RequestBodyLBS content) context + + +-- | publish from a 'Source' (refer to 'requestBodySource') +sendTopicBodySrc :: String -> Int64 -> Source IO C.ByteString -> SBContext -> IO () +sendTopicBodySrc topicName len bodysrc context = sendTopicRequest topicName (requestBodySource len bodysrc) context + + +-- | Reads and deletes the message from a topic at a given subscription. +-- +-- +-- In order to destructively read the latest message from the subscription /subsc/ on topic /t/ (with a time out of n seconds), +-- +-- +-- @ +-- destructiveRead t subsc n context +-- @ +-- Note that the timeout can be at the most 55 seconds. +destructiveRead :: String -> String -> Int -> SBContext -> IO (L.ByteString) +destructiveRead topic subsc timeout context = destructiveReadRequest topic subsc (timeout `mod` 55) context + +-- | Peek Lock Message from a Topic. Non-Destructive Read. +-- +-- Atomically retrieves the message from a topic (on a given subscription) without deleting it. The message is locked for a duration so that it is not visible to other +-- receivers. +-- +-- Refer for semantics of the underlying REST API. +peekLockTopic :: String -> String -> Int -> SBContext -> IO (LockedMsgInfo,L.ByteString) +peekLockTopic topic subscr timeout (SBContext baseUrl manager aContext) = do + token <- acsToken manager aContext + reqInit <- parseUrl (baseUrl ++ "/" ++ topic ++ "/Subscriptions/" ++ subscr ++ "/messages/head?timeout=" ++ (show timeout)) + res <-withSocketsDo $ httpLbs (reqInit { method = methodPost, + requestHeaders = [token] + }) manager + return $ (getQLI res,responseBody res) diff --git a/Web/WindowsAzure/ServiceBus.hs b/Web/WindowsAzure/ServiceBus.hs --- a/Web/WindowsAzure/ServiceBus.hs +++ b/Web/WindowsAzure/ServiceBus.hs @@ -1,9 +1,21 @@ +-- | +-- Module : Web.WindowsAzure.ServiceBus +-- Description : Haskell Types for interacting with ServiceBus +-- Copyright : (c) Hemanth Kapila, 2014 +-- License : BSD3 +-- Maintainer : saihemanth@gmail.com +-- Stability : Experimental +-- +-- __deprecated__ Use "Network.MicrosoftAzure.ServiceBus" instead. +-- +-- Haskell API for working with + module Web.WindowsAzure.ServiceBus ( -- * Servicebus Types SBInfo (..), -- | Abstract type representing the service bus context. SBContext, - -- Broker Properties + -- Broker Properties BrokerProperties (..), -- * Initialization simpleSBInfo, diff --git a/Web/WindowsAzure/ServiceBus/Queue.hs b/Web/WindowsAzure/ServiceBus/Queue.hs --- a/Web/WindowsAzure/ServiceBus/Queue.hs +++ b/Web/WindowsAzure/ServiceBus/Queue.hs @@ -6,6 +6,8 @@ -- Maintainer : saihemanth@gmail.com -- Stability : Experimental -- +-- __ deprecated __ Use "Network.MicrosoftAzure.ServiceBus.Queue" instead. +-- -- Provides API to pull from and push to ServiceBus queue -- Please refer to for information on the API provided by -- Microsoft Service bus. @@ -16,25 +18,25 @@ -- import Web.WindowsAzure.ServiceBus.Queue -- import Web.WindowsAzure.ServiceBus -- import qualified Data.ByteString.Char8 as C --- +-- -- queueName = "queueName" -- sbNamespace = "namespace" -- sbIssuerKey = C.pack "1287361251262as=" -- sbIssuerName = C.pack "owner" --- --- sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey +-- +-- sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey -- message = C.pack "Hello from Haskell" --- +-- -- main = do -- sbContext <- sbContext sbinfo -- enQueueBS queueName message sbContext -- res <- deQueue queueName 30 sbContext -- print res -- @ --- +-- -- see examples (available as a part of distribution) for a more detailed example. -module Web.WindowsAzure.ServiceBus.Queue( +module Web.WindowsAzure.ServiceBus.Queue( -- Locked Message Info QLockedMsgInfo, -- * Pushing data to Queue @@ -68,11 +70,11 @@ -- | 'QLockedMsgInfo' provides Information of the locked message from a queue. -- -data QLockedMsgInfo = QLockedMsgInfo String BrokerProperties +data QLockedMsgInfo = QLockedMsgInfo String BrokerProperties deriving (Show) --- | Internal low-level method for performing HTTP calls. --- +-- | Internal low-level method for performing HTTP calls. +-- -- Not exposed to the user enQueueRequest :: String -> RequestBody -> SBContext -> IO () enQueueRequest queueName body (SBContext baseUrl manager aContext) = do @@ -84,14 +86,14 @@ }) manager return () --- | Internal low-level method for creating the HTTP calls. For internal use. --- --- should be avoided by most users +-- | Internal low-level method for creating the HTTP calls. For internal use. +-- +-- should be avoided by most users deQueueRequest :: String -> Int -> SBContext -> IO L.ByteString deQueueRequest queueName timeout (SBContext baseUrl manager aContext) = do token <- acsToken manager aContext reqInit <- parseUrl (baseUrl ++ "/" ++ queueName ++ "/messages/head?timeout=" ++ (show timeout)) - res <-withSocketsDo $ httpLbs ( reqInit { method = methodDelete, + res <-withSocketsDo $ httpLbs ( reqInit { method = methodDelete, requestHeaders = [token] }) manager return $ responseBody res @@ -104,38 +106,38 @@ -- enQueueBS q bs ctx -- @ enQueueBS :: String -> C.ByteString -> SBContext -> IO () -enQueueBS queueName content context = +enQueueBS queueName content context = enQueueRequest queueName (RequestBodyBS content) context - - + + -- | publish a message containing 'L.ByteString' to queue --- --- The following publishes a lazy bytestring ,\lbs\, to queue \q\, --- --- @ +-- +-- The following publishes a lazy bytestring ,\lbs\, to queue \q\, +-- +-- @ -- enQueueLBS q lbs ctx --- @ --- -enQueueLBS :: String -> L.ByteString -> SBContext -> IO () -enQueueLBS queueName content context = +-- @ +-- +enQueueLBS :: String -> L.ByteString -> SBContext -> IO () +enQueueLBS queueName content context = enQueueRequest queueName (RequestBodyLBS content) context - - + + -- | publish from a 'Source' (refer to 'requestBodySource') enQueueBodySrc :: String -> Int64 -> Source IO C.ByteString -> SBContext -> IO () enQueueBodySrc queueName len bodysrc context = enQueueRequest queueName (requestBodySource len bodysrc) context - --- | Reads and deletes the message from a queue. --- --- --- In order to destructively read the latest message from the queue (with a time out of n seconds), --- --- --- @ + +-- | Reads and deletes the message from a queue. +-- +-- +-- In order to destructively read the latest message from the queue (with a time out of n seconds), +-- +-- +-- @ -- deQueue queueName n context -- @ --- Note that the timeout can be at the most 55 seconds. This silently \ignores\ the timeouts greater than 55 +-- Note that the timeout can be at the most 55 seconds. This silently \ignores\ the timeouts greater than 55 deQueue :: String -> Int -> SBContext -> IO (L.ByteString) deQueue queueName timeout context = deQueueRequest queueName (timeout `mod` 55) context @@ -153,4 +155,3 @@ requestHeaders = [token] }) manager return $ (getQLI res,responseBody res) - diff --git a/Web/WindowsAzure/ServiceBus/SBTypes.hs b/Web/WindowsAzure/ServiceBus/SBTypes.hs --- a/Web/WindowsAzure/ServiceBus/SBTypes.hs +++ b/Web/WindowsAzure/ServiceBus/SBTypes.hs @@ -6,10 +6,11 @@ -- Maintainer : saihemanth@gmail.com -- Stability : Experimental -- +-- __ deprecated __ -- Provides Types used across the rest of the API. --- +-- {-# LANGUAGE OverloadedStrings #-} -module Web.WindowsAzure.ServiceBus.SBTypes +module Web.WindowsAzure.ServiceBus.SBTypes where import qualified Data.ByteString.Char8 as C @@ -34,28 +35,28 @@ -- | 'SBInfo' is encapsulation of Connection Information needed to connect to a Service Bus Namespace. --- +-- -- This information is typically found when you click on the /Connection Information/ link on the azure portal and comprises of -- -- * ServiceBus namespace -- * Issuer Name -- * Issuer Key --- +-- data SBInfo = SBInfo String C.ByteString C.ByteString deriving (Show) -- | Abstract type representing the service bus context. -data SBContext = SBContext String Manager AcsContext +data SBContext = SBContext String Manager AcsContext -- | a convenience function, where issuer name is owner simpleSBInfo :: String -> String -> SBInfo simpleSBInfo ns key = SBInfo ns (C.pack "owner") (C.pack key) -- | Create SB Context from 'SBInfo' -sbContext :: SBInfo -> IO SBContext +sbContext :: SBInfo -> IO SBContext sbContext (SBInfo ns name key) = do aContext <- acsContext $ AcsInfo (ns ++ "-sb") (C.pack $ "http://" ++ ns ++ ".servicebus.windows.net") name key - manager <- newManagerSettings (mkManagerSettings (TLSSettingsSimple True False False) Nothing) + manager <- newManagerSettings (mkManagerSettings (TLSSettingsSimple True False False) Nothing) return $ SBContext ("https://" ++ ns ++ ".servicebus.windows.net") manager aContext -- | BrokerProperties @@ -80,7 +81,7 @@ v .: "LockToken" <*> v .: "LockedUntilUtc" <*> v .: "MessageId" <*> - v .: "SequenceNumber" <*> + v .: "SequenceNumber" <*> v .: "State" <*> v .: "TimeToLive" parseJSON _ = mempty @@ -102,12 +103,12 @@ -- | 'LockedMsgInfo' provides Information of the locked message. -- -data LockedMsgInfo = LockedMsgInfo String BrokerProperties +data LockedMsgInfo = LockedMsgInfo String BrokerProperties deriving (Show) -- | Unlock a messages that has been locked earlier. --- +-- -- see 'Web.WindowsAzure.ServiceBus.Topic.peekLockTopic' and 'Web.WindowsAzure.ServiceBus.Queue.peekLockQueue'. -- -- Also consult and for details on the underlying REST API. @@ -121,7 +122,7 @@ return () -- | Delete a message that has been locked earlier. --- +-- -- see 'Web.WindowsAzure.ServiceBus.Topic.peekLockTopic' and 'Web.WindowsAzure.ServiceBus.Queue.peekLockQueue'. -- -- Also consult and for details on the underlying REST API. @@ -135,7 +136,7 @@ return () -- | Renews lock on a locked message --- +-- -- see 'Web.WindowsAzure.ServiceBus.Topic.peekLockTopic' and 'Web.WindowsAzure.ServiceBus.Queue.peekLockQueue'. -- -- Also consult and for details on the underlying REST API. @@ -151,7 +152,7 @@ getQLI :: Response L.ByteString -> LockedMsgInfo -getQLI res = LockedMsgInfo loc bp +getQLI res = LockedMsgInfo loc bp where loc = case lookup hLocation (responseHeaders res) of Nothing -> error "Expected Location Header in the response!" diff --git a/Web/WindowsAzure/ServiceBus/Topic.hs b/Web/WindowsAzure/ServiceBus/Topic.hs --- a/Web/WindowsAzure/ServiceBus/Topic.hs +++ b/Web/WindowsAzure/ServiceBus/Topic.hs @@ -6,6 +6,8 @@ -- Maintainer : saihemanth@gmail.com -- Stability : Experimental -- +-- __ Deprecated __ Use "Network.MicrosoftAzure.ServiceBus.Topic" instead. +-- -- Provides API to pull from and push to ServiceBus topic -- Please refer to for information on the API provided by -- Microsoft Service bus. @@ -16,26 +18,26 @@ -- import Web.WindowsAzure.ServiceBus.Topic -- import Web.WindowsAzure.ServiceBus -- import qualified Data.ByteString.Char8 as C --- +-- -- topicName = "topicName" -- subscriptionName = "subscriptionName" -- sbNamespace = "namespace" -- sbIssuerKey = C.pack "1287361251262as=" -- sbIssuerName = C.pack "owner" --- --- sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey +-- +-- sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey -- message = C.pack "Hello from Haskell" --- +-- -- main = do -- sbContext <- sbContext sbinfo -- sendTopicBS topicName message sbContext -- res <- destructiveRead topicName subscriptionName 30 sbContext -- print res -- @ --- +-- -- see examples (available as a part of distribution) for a more detailed example. -module Web.WindowsAzure.ServiceBus.Topic( +module Web.WindowsAzure.ServiceBus.Topic( -- * Pushing data to Topic sendTopicBS, sendTopicLBS, @@ -65,8 +67,8 @@ import Data.Aeson import Network(withSocketsDo) --- | Internal low-level method for performing HTTP calls. --- +-- | Internal low-level method for performing HTTP calls. +-- -- Not exposed to the user sendTopicRequest :: String -> RequestBody -> SBContext -> IO () sendTopicRequest topicName body (SBContext baseUrl manager aContext) = do @@ -78,14 +80,14 @@ }) manager return () --- | Internal low-level method for creating the HTTP calls. For internal use. --- +-- | Internal low-level method for creating the HTTP calls. For internal use. +-- -- Not exposed to the user destructiveReadRequest :: String -> String -> Int -> SBContext -> IO L.ByteString destructiveReadRequest topic subsc timeout (SBContext baseUrl manager aContext) = do token <- acsToken manager aContext reqInit <- parseUrl (baseUrl ++ "/" ++ topic ++ "/Subscriptions/" ++ subsc ++ "/messages/head?timeout=" ++ (show timeout)) - res <-withSocketsDo $ httpLbs ( reqInit { method = methodDelete, + res <-withSocketsDo $ httpLbs ( reqInit { method = methodDelete, requestHeaders = [token] }) manager return $ responseBody res @@ -98,38 +100,38 @@ -- sendTopicBS t bs ctx -- @ sendTopicBS :: String -> C.ByteString -> SBContext -> IO () -sendTopicBS topicName content context = +sendTopicBS topicName content context = sendTopicRequest topicName (RequestBodyBS content) context - - + + -- | publish a message containing 'L.ByteString' to a topic --- --- The following publishes a lazy bytestring ,\lbs\, to topic \t\, --- --- @ +-- +-- The following publishes a lazy bytestring ,\lbs\, to topic \t\, +-- +-- @ -- sendTopicLBS t lbs ctx --- @ --- -sendTopicLBS :: String -> L.ByteString -> SBContext -> IO () -sendTopicLBS topicName content context = +-- @ +-- +sendTopicLBS :: String -> L.ByteString -> SBContext -> IO () +sendTopicLBS topicName content context = sendTopicRequest topicName (RequestBodyLBS content) context - - + + -- | publish from a 'Source' (refer to 'requestBodySource') sendTopicBodySrc :: String -> Int64 -> Source IO C.ByteString -> SBContext -> IO () sendTopicBodySrc topicName len bodysrc context = sendTopicRequest topicName (requestBodySource len bodysrc) context - --- | Reads and deletes the message from a topic at a given subscription. --- --- --- In order to destructively read the latest message from the subscription /subsc/ on topic /t/ (with a time out of n seconds), --- --- --- @ + +-- | Reads and deletes the message from a topic at a given subscription. +-- +-- +-- In order to destructively read the latest message from the subscription /subsc/ on topic /t/ (with a time out of n seconds), +-- +-- +-- @ -- destructiveRead t subsc n context -- @ --- Note that the timeout can be at the most 55 seconds. +-- Note that the timeout can be at the most 55 seconds. destructiveRead :: String -> String -> Int -> SBContext -> IO (L.ByteString) destructiveRead topic subsc timeout context = destructiveReadRequest topic subsc (timeout `mod` 55) context diff --git a/azure-servicebus.cabal b/azure-servicebus.cabal --- a/azure-servicebus.cabal +++ b/azure-servicebus.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: azure-servicebus -version: 0.1.5.0 +version: 0.1.6.0 synopsis: Haskell wrapper over Microsoft Azure ServiceBus REST API Description: /Overview/ @@ -42,11 +42,15 @@ library exposed-modules: Web.WindowsAzure.ServiceBus.Queue, Web.WindowsAzure.ServiceBus.Topic, - Web.WindowsAzure.ServiceBus - other-modules: Web.WindowsAzure.ServiceBus.SBTypes + Web.WindowsAzure.ServiceBus, + Network.MicrosoftAzure.ServiceBus.Queue, + Network.MicrosoftAzure.ServiceBus.Topic, + Network.MicrosoftAzure.ServiceBus + other-modules: Web.WindowsAzure.ServiceBus.SBTypes, + Network.MicrosoftAzure.ServiceBus.SBTypes -- other-extensions: build-depends: base >=4.6 && < 5.0, - azure-acs <0.2, + azure-acs >= 0.0.1.0 && <0.2, bytestring >=0.10 && <0.12, http-conduit >=2.1 && <2.2, conduit >=1.1 && <1.2, diff --git a/examples/QueueExample.hs b/examples/QueueExample.hs --- a/examples/QueueExample.hs +++ b/examples/QueueExample.hs @@ -1,7 +1,7 @@ module Main where -import Web.WindowsAzure.ServiceBus.Queue -import Web.WindowsAzure.ServiceBus +import Network.MicrosoftAzure.ServiceBus.Queue +import Network.MicrosoftAzure.ServiceBus import qualified Data.ByteString.Char8 as C import Network(withSocketsDo) @@ -10,7 +10,7 @@ sbIssuerKey = C.pack "somekey23823872=" sbIssuerName = C.pack "owner" -sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey +sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey message1 = C.pack "Hello from Haskell" message2 = C.pack "Haskell Rocks" @@ -34,4 +34,3 @@ renewLock lockInfo sbContext -- delete the message deleteMessage lockInfo sbContext - diff --git a/examples/TopicExample.hs b/examples/TopicExample.hs --- a/examples/TopicExample.hs +++ b/examples/TopicExample.hs @@ -1,7 +1,7 @@ module Main where -import Web.WindowsAzure.ServiceBus.Topic -import Web.WindowsAzure.ServiceBus +import Network.MicrosoftAzure.ServiceBus.Topic +import Network.MicrosoftAzure.ServiceBus import qualified Data.ByteString.Char8 as C import Network(withSocketsDo) @@ -11,7 +11,7 @@ sbIssuerKey = C.pack "someSubscriptionKey=" sbIssuerName = C.pack "owner" -sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey +sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey message1 = C.pack "Hello from Haskell" message2 = C.pack "Haskell Rocks" @@ -35,4 +35,3 @@ renewLock lockInfo sbContext -- delete the message deleteMessage lockInfo sbContext -