diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,30 @@ -Copyright (c) 2014, Hemanth Kapila - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Hemanth Kapila nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c) 2014, Hemanth Kapila + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Hemanth Kapila nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/Web/WindowsAzure/ServiceBus.hs b/Web/WindowsAzure/ServiceBus.hs new file mode 100644 --- /dev/null +++ b/Web/WindowsAzure/ServiceBus.hs @@ -0,0 +1,12 @@ +module Web.WindowsAzure.ServiceBus ( + -- * Servicebus Types + SBInfo (..), + -- | Abstract type representing the service bus context. + SBContext, + -- Broker Properties + BrokerProperties (..), + -- * Initialization + simpleSBInfo, + sbContext ) where + +import Web.WindowsAzure.ServiceBus.SBTypes 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 @@ -1,88 +1,215 @@ --- | --- Module : Web.WindowsAzure.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 Service bus API --- --- Following piece of code illustrates the use of API --- --- @ --- module Main where --- --- import Web.WindowsAzure.ServiceBus.SBTypes --- import Web.WindowsAzure.ServiceBus.Queue --- import qualified Data.ByteString.Char8 as C --- --- main = do --- sbContext <- sbContext (simpleSBInfo "sb-namespace" "insert-your-issuer-key") --- enQueueBS sbContext "queue-name" (C.pack "hello Haskell world") --- res <- deQueue sbContext "kqueue" 30 --- print res --- @ --- - -module Web.WindowsAzure.ServiceBus.Queue( - -- * Pushing data to Queue - enQueueBS, - enQueueLBS, - enQueueBodySrc, - -- * Reading data from Queue - deQueue - )where - -import Web.WindowsAzure.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 -import Data.Conduit -import Data.Int - --- | 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 - +-- | +-- Module : Web.WindowsAzure.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 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 +-- 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( + -- Locked Message Info + QLockedMsgInfo, + -- * Pushing data to Queue + enQueueBS, + enQueueLBS, + enQueueBodySrc, + -- * Reading data from Queue + deQueue, + peekLockQueue, + unlockMessage, + deleteMessage, + renewLock + )where + +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import Data.Conduit +import Data.Int + +import Web.WindowsAzure.ACS +import Web.WindowsAzure.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) + + +-- | '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 (QLockedMsgInfo,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) + +getQLI :: Response L.ByteString -> QLockedMsgInfo +getQLI res = QLockedMsgInfo 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 + +-- | Unlock a messages that has been locked earlier. +-- +-- Given a queueName and the broker properties of the message that has been locked before, +-- 'unlockMessage' removes the lock so that the message can be consumed by other consumers. +-- +-- see 'peekLockQueue' and for details on the underlying API. +unlockMessage :: String -> QLockedMsgInfo -> SBContext -> IO () +unlockMessage queueName (QLockedMsgInfo 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. +-- +-- Given a queueName and the locked message info, 'deleteMessage' deletes the message from the queue +-- +-- see 'peekLockQueue' and for details on the underlying API. +deleteMessage :: String -> QLockedMsgInfo -> SBContext -> IO () +deleteMessage queueName (QLockedMsgInfo 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 +-- +-- Given a queueName and the locked-message info, 'renewLock' renews the lock +-- 'deleteMessage' deletes the message from the queue +-- +-- see 'peekLockQueue' and for details on the underlying API. +renewLock :: String -> QLockedMsgInfo -> SBContext -> IO () +renewLock queueName (QLockedMsgInfo url brokerProps) (SBContext baseUrl manager acsContext) = do + token <- acsToken manager acsContext + reqInit <- parseUrl url + res <-withSocketsDo $ httpLbs (reqInit { method = methodPost, + requestHeaders = [token] + }) manager + return () 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 @@ -1,83 +1,99 @@ --- | --- Module : Web.WindowsAzure.ServiceBus.SBTypes --- Description : Defines Types for dealing with Windows Azure Service Bus --- Copyright : (c) Hemanth Kapila, 2014 --- License : BSD3 --- Maintainer : saihemanth@gmail.com --- Stability : Experimental --- --- - -module Web.WindowsAzure.ServiceBus.SBTypes( - -- * Types - SBInfo(..), - SBContext, - -- * initialization - sbContext, - simpleSBInfo, - -- * low-level functions for creating 'Request' - enQueueRequest, - deQueueRequest - )where - -import Web.WindowsAzure.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(methodPost,methodDelete) - -import Network.Connection (TLSSettings (..)) - - - --- | '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 - - --- | Internal low-level method for performing HTTP calls. --- --- should be avoided by most users. -enQueueRequest :: String -> RequestBody -> SBContext -> IO () -enQueueRequest queueName body (SBContext baseUrl manager aContext) = do - token <- acsToken manager aContext - reqInit <- parseUrl (baseUrl ++ "/" ++ queueName ++ "/messages") - 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 <- httpLbs ( reqInit { method = methodDelete, - requestHeaders = [token] - }) manager - return $ responseBody res +-- | +-- Module : Web.WindowsAzure.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 Web.WindowsAzure.ServiceBus.SBTypes + where + +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import Data.Conduit +import Data.Int + +import Web.WindowsAzure.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) +import Network.HTTP.Types.Header + +import Network.Connection (TLSSettings (..)) +import Data.Aeson +import Data.Monoid +import Control.Applicative + + +-- | '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 diff --git a/azure-servicebus.cabal b/azure-servicebus.cabal --- a/azure-servicebus.cabal +++ b/azure-servicebus.cabal @@ -1,41 +1,48 @@ --- Initial azure-servicebus.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - -name: azure-servicebus -version: 0.1.0.1 -synopsis: Windows Azure ServiceBus API -description: Haskell wrappers over Windows Azure ServiceBus API. -homepage: https://github.com/kapilash/hs-azure -license: BSD3 -license-file: LICENSE -author: Hemanth Kapila -maintainer: saihemanth@gmail.com -copyright: Hemanth Kapila (c) 2014-2015 -category: Web -build-type: Simple -extra-source-files: examples/*.hs -cabal-version: >=1.10 - -library - exposed-modules: Web.WindowsAzure.ServiceBus.Queue, - Web.WindowsAzure.ServiceBus.SBTypes - -- other-modules: - -- other-extensions: - build-depends: base >=4.0 && < 5.0, - azure-acs >=0.0 && <0.2, - bytestring >=0.10 && <0.12, - http-conduit >=2.1 && <2.2, - conduit >=1.1 && <1.2, - http-types >=0.8 && <0.9, - attoparsec >=0.10 && <0.12, - async , - http-client, - connection - -- hs-source-dirs: - default-language: Haskell2010 - ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-unused-do-bind - ghc-prof-options: -prof -auto-all - -source-repository head - type: git - location: https://github.com/kapilash/hs-azure.git +-- Initial azure-servicebus.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: azure-servicebus +version: 0.1.1.0 +synopsis: Haskell wrapper over Microsoft Azure ServiceBus REST API +description: + This library provides haskell wrappers over Microsoft Azure ServiceBus REST API. + The current version provides for queues. + +homepage: https://github.com/kapilash/hs-azure +license: BSD3 +license-file: LICENSE +author: Hemanth Kapila +maintainer: saihemanth@gmail.com +copyright: Hemanth Kapila (c) 2014-2015 +category: Web +build-type: Simple +extra-source-files: examples/*.hs +cabal-version: >=1.10 + +library + exposed-modules: Web.WindowsAzure.ServiceBus.Queue, + Web.WindowsAzure.ServiceBus + other-modules: Web.WindowsAzure.ServiceBus.SBTypes + -- other-extensions: + build-depends: base >=4.6 && < 5.0, + azure-acs <0.2, + bytestring >=0.10 && <0.12, + http-conduit >=2.1 && <2.2, + conduit >=1.1 && <1.2, + http-types >=0.8 && <0.9, + attoparsec >=0.10 && <0.12, + case-insensitive >= 1.2, + aeson >= 0.7.0.0, + text >= 1.1.0.0, + async , + http-client, + connection, + network + -- hs-source-dirs: + default-language: Haskell2010 + ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-unused-do-bind + ghc-prof-options: -prof -auto-all + +source-repository head + type: git + location: https://github.com/kapilash/hs-azure.git diff --git a/examples/Example.hs b/examples/Example.hs --- a/examples/Example.hs +++ b/examples/Example.hs @@ -1,11 +1,37 @@ -module Main where - -import Web.WindowsAzure.ServiceBus.Queue -import Web.WindowsAzure.ServiceBus.SBTypes -import qualified Data.ByteString.Char8 as C - -main = do - sbContext <- sbContext (simpleSBInfo "sb-namespace" "issuer-key") - enQueueBS "queue-name" (C.pack "hello Haskell world") sbContext - res <- deQueue "queue-name" 30 sbContext +module Main where + +import Web.WindowsAzure.ServiceBus.Queue +import Web.WindowsAzure.ServiceBus +import qualified Data.ByteString.Char8 as C +import Network(withSocketsDo) + +queueName = "QUEUE-NAME" +sbNamespace = "sb-namespace" +sbIssuerKey = C.pack "somekey23823872=" +sbIssuerName = C.pack "owner" + +sbinfo = SBInfo sbNamespace sbIssuerName sbIssuerKey +message1 = C.pack "Hello from Haskell" +message2 = C.pack "Haskell Rocks" + +main = do + sbContext <- sbContext sbinfo + enQueueBS queueName message1 sbContext + -- Enqueued message 1 to queue + res <- deQueue queueName 30 sbContext + -- Dequeued it print res + -- Enqueue it again + enQueueBS queueName message1 sbContext + -- EnQueue Another Message + enQueueBS queueName message2 sbContext + -- Peek Lock on the first message + (lockInfo,msgFromQueue) <- peekLockQueue queueName 50 sbContext + -- Now a deQueue would result in us getting the second message (while the first is still in the queue) + res3 <- deQueue queueName 10 sbContext + print res3 + -- renew lock + renewLock queueName lockInfo sbContext + -- delete the message + deleteMessage queueName lockInfo sbContext +